1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.107 2002/12/11 15:36:42 simonmar 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
34 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
35 #include <HaskellSupport/dlfcn.h>
36 #elif defined(HAVE_DLFCN_H)
40 #if defined(cygwin32_TARGET_OS)
45 #ifdef HAVE_SYS_TIME_H
49 #include <sys/fcntl.h>
50 #include <sys/termios.h>
51 #include <sys/utime.h>
52 #include <sys/utsname.h>
56 #if defined(ia64_TARGET_ARCH)
62 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
63 # define OBJFORMAT_ELF
64 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
65 # define OBJFORMAT_PEi386
68 #elif defined(darwin_TARGET_OS)
69 # include <mach-o/ppc/reloc.h>
70 # define OBJFORMAT_MACHO
71 # include <mach-o/loader.h>
72 # include <mach-o/nlist.h>
73 # include <mach-o/reloc.h>
76 /* Hash table mapping symbol names to Symbol */
77 static /*Str*/HashTable *symhash;
79 /* List of currently loaded objects */
80 ObjectCode *objects = NULL; /* initially empty */
82 #if defined(OBJFORMAT_ELF)
83 static int ocVerifyImage_ELF ( ObjectCode* oc );
84 static int ocGetNames_ELF ( ObjectCode* oc );
85 static int ocResolve_ELF ( ObjectCode* oc );
86 #elif defined(OBJFORMAT_PEi386)
87 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
88 static int ocGetNames_PEi386 ( ObjectCode* oc );
89 static int ocResolve_PEi386 ( ObjectCode* oc );
90 #elif defined(OBJFORMAT_MACHO)
91 static int ocVerifyImage_MachO ( ObjectCode* oc );
92 static int ocGetNames_MachO ( ObjectCode* oc );
93 static int ocResolve_MachO ( ObjectCode* oc );
96 /* -----------------------------------------------------------------------------
97 * Built-in symbols from the RTS
100 typedef struct _RtsSymbolVal {
107 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
109 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
110 SymX(makeStableNamezh_fast) \
111 SymX(finalizzeWeakzh_fast)
113 /* These are not available in GUM!!! -- HWL */
114 #define Maybe_ForeignObj
115 #define Maybe_Stable_Names
118 #if !defined (mingw32_TARGET_OS)
119 #define RTS_POSIX_ONLY_SYMBOLS \
120 SymX(stg_sig_install) \
124 #if defined (cygwin32_TARGET_OS)
125 #define RTS_MINGW_ONLY_SYMBOLS /**/
126 /* Don't have the ability to read import libs / archives, so
127 * we have to stupidly list a lot of what libcygwin.a
130 #define RTS_CYGWIN_ONLY_SYMBOLS \
212 #elif !defined(mingw32_TARGET_OS)
213 #define RTS_MINGW_ONLY_SYMBOLS /**/
214 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
215 #else /* defined(mingw32_TARGET_OS) */
216 #define RTS_POSIX_ONLY_SYMBOLS /**/
217 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
219 /* These are statically linked from the mingw libraries into the ghc
220 executable, so we have to employ this hack. */
221 #define RTS_MINGW_ONLY_SYMBOLS \
233 SymX(getservbyname) \
234 SymX(getservbyport) \
235 SymX(getprotobynumber) \
236 SymX(getprotobyname) \
237 SymX(gethostbyname) \
238 SymX(gethostbyaddr) \
273 Sym(_imp___timezone) \
289 # define MAIN_CAP_SYM SymX(MainCapability)
291 # define MAIN_CAP_SYM
294 #define RTS_SYMBOLS \
299 SymX(stg_enter_info) \
300 SymX(stg_enter_ret) \
301 SymX(stg_gc_void_info) \
302 SymX(__stg_gc_enter_1) \
303 SymX(stg_gc_noregs) \
304 SymX(stg_gc_unpt_r1_info) \
305 SymX(stg_gc_unpt_r1) \
306 SymX(stg_gc_unbx_r1_info) \
307 SymX(stg_gc_unbx_r1) \
308 SymX(stg_gc_f1_info) \
310 SymX(stg_gc_d1_info) \
312 SymX(stg_gc_l1_info) \
315 SymX(stg_gc_fun_info) \
316 SymX(stg_gc_fun_ret) \
318 SymX(stg_gc_gen_info) \
319 SymX(stg_gc_gen_hp) \
321 SymX(stg_gen_yield) \
322 SymX(stg_yield_noregs) \
323 SymX(stg_yield_to_interpreter) \
324 SymX(stg_gen_block) \
325 SymX(stg_block_noregs) \
327 SymX(stg_block_takemvar) \
328 SymX(stg_block_putmvar) \
329 SymX(stg_seq_frame_info) \
332 SymX(MallocFailHook) \
333 SymX(NoRunnableThreadsHook) \
335 SymX(OutOfHeapHook) \
336 SymX(PatErrorHdrHook) \
337 SymX(PostTraceHook) \
339 SymX(StackOverflowHook) \
340 SymX(__encodeDouble) \
341 SymX(__encodeFloat) \
344 SymX(__gmpz_cmp_si) \
345 SymX(__gmpz_cmp_ui) \
346 SymX(__gmpz_get_si) \
347 SymX(__gmpz_get_ui) \
348 SymX(__int_encodeDouble) \
349 SymX(__int_encodeFloat) \
350 SymX(andIntegerzh_fast) \
351 SymX(blockAsyncExceptionszh_fast) \
354 SymX(complementIntegerzh_fast) \
355 SymX(cmpIntegerzh_fast) \
356 SymX(cmpIntegerIntzh_fast) \
357 SymX(createAdjustor) \
358 SymX(decodeDoublezh_fast) \
359 SymX(decodeFloatzh_fast) \
362 SymX(deRefWeakzh_fast) \
363 SymX(deRefStablePtrzh_fast) \
364 SymX(divExactIntegerzh_fast) \
365 SymX(divModIntegerzh_fast) \
367 SymX(forkProcesszh_fast) \
368 SymX(freeHaskellFunctionPtr) \
369 SymX(freeStablePtr) \
370 SymX(gcdIntegerzh_fast) \
371 SymX(gcdIntegerIntzh_fast) \
372 SymX(gcdIntzh_fast) \
375 SymX(int2Integerzh_fast) \
376 SymX(integer2Intzh_fast) \
377 SymX(integer2Wordzh_fast) \
378 SymX(isDoubleDenormalized) \
379 SymX(isDoubleInfinite) \
381 SymX(isDoubleNegativeZero) \
382 SymX(isEmptyMVarzh_fast) \
383 SymX(isFloatDenormalized) \
384 SymX(isFloatInfinite) \
386 SymX(isFloatNegativeZero) \
387 SymX(killThreadzh_fast) \
388 SymX(makeStablePtrzh_fast) \
389 SymX(minusIntegerzh_fast) \
390 SymX(mkApUpd0zh_fast) \
391 SymX(myThreadIdzh_fast) \
392 SymX(labelThreadzh_fast) \
393 SymX(newArrayzh_fast) \
394 SymX(newBCOzh_fast) \
395 SymX(newByteArrayzh_fast) \
397 SymX(newMVarzh_fast) \
398 SymX(newMutVarzh_fast) \
399 SymX(atomicModifyMutVarzh_fast) \
400 SymX(newPinnedByteArrayzh_fast) \
401 SymX(orIntegerzh_fast) \
403 SymX(plusIntegerzh_fast) \
406 SymX(putMVarzh_fast) \
407 SymX(quotIntegerzh_fast) \
408 SymX(quotRemIntegerzh_fast) \
410 SymX(remIntegerzh_fast) \
411 SymX(resetNonBlockingFd) \
414 SymX(rts_checkSchedStatus) \
417 SymX(rts_evalLazyIO) \
421 SymX(rts_getDouble) \
426 SymX(rts_getStablePtr) \
427 SymX(rts_getThreadId) \
429 SymX(rts_getWord32) \
440 SymX(rts_mkStablePtr) \
449 SymX(shutdownHaskellAndExit) \
450 SymX(stable_ptr_table) \
451 SymX(stackOverflow) \
452 SymX(stg_CAF_BLACKHOLE_info) \
453 SymX(stg_CHARLIKE_closure) \
454 SymX(stg_EMPTY_MVAR_info) \
455 SymX(stg_IND_STATIC_info) \
456 SymX(stg_INTLIKE_closure) \
457 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
458 SymX(stg_WEAK_info) \
459 SymX(stg_ap_v_info) \
460 SymX(stg_ap_f_info) \
461 SymX(stg_ap_d_info) \
462 SymX(stg_ap_l_info) \
463 SymX(stg_ap_n_info) \
464 SymX(stg_ap_p_info) \
465 SymX(stg_ap_pv_info) \
466 SymX(stg_ap_pp_info) \
467 SymX(stg_ap_ppv_info) \
468 SymX(stg_ap_ppp_info) \
469 SymX(stg_ap_pppp_info) \
470 SymX(stg_ap_ppppp_info) \
471 SymX(stg_ap_pppppp_info) \
472 SymX(stg_ap_ppppppp_info) \
480 SymX(stg_ap_pv_ret) \
481 SymX(stg_ap_pp_ret) \
482 SymX(stg_ap_ppv_ret) \
483 SymX(stg_ap_ppp_ret) \
484 SymX(stg_ap_pppp_ret) \
485 SymX(stg_ap_ppppp_ret) \
486 SymX(stg_ap_pppppp_ret) \
487 SymX(stg_ap_ppppppp_ret) \
488 SymX(stg_ap_1_upd_info) \
489 SymX(stg_ap_2_upd_info) \
490 SymX(stg_ap_3_upd_info) \
491 SymX(stg_ap_4_upd_info) \
492 SymX(stg_ap_5_upd_info) \
493 SymX(stg_ap_6_upd_info) \
494 SymX(stg_ap_7_upd_info) \
495 SymX(stg_ap_8_upd_info) \
497 SymX(stg_sel_0_upd_info) \
498 SymX(stg_sel_10_upd_info) \
499 SymX(stg_sel_11_upd_info) \
500 SymX(stg_sel_12_upd_info) \
501 SymX(stg_sel_13_upd_info) \
502 SymX(stg_sel_14_upd_info) \
503 SymX(stg_sel_15_upd_info) \
504 SymX(stg_sel_1_upd_info) \
505 SymX(stg_sel_2_upd_info) \
506 SymX(stg_sel_3_upd_info) \
507 SymX(stg_sel_4_upd_info) \
508 SymX(stg_sel_5_upd_info) \
509 SymX(stg_sel_6_upd_info) \
510 SymX(stg_sel_7_upd_info) \
511 SymX(stg_sel_8_upd_info) \
512 SymX(stg_sel_9_upd_info) \
513 SymX(stg_upd_frame_info) \
514 SymX(suspendThread) \
515 SymX(takeMVarzh_fast) \
516 SymX(timesIntegerzh_fast) \
517 SymX(tryPutMVarzh_fast) \
518 SymX(tryTakeMVarzh_fast) \
519 SymX(unblockAsyncExceptionszh_fast) \
520 SymX(unsafeThawArrayzh_fast) \
521 SymX(waitReadzh_fast) \
522 SymX(waitWritezh_fast) \
523 SymX(word2Integerzh_fast) \
524 SymX(xorIntegerzh_fast) \
527 #ifdef SUPPORT_LONG_LONGS
528 #define RTS_LONG_LONG_SYMS \
529 SymX(int64ToIntegerzh_fast) \
530 SymX(word64ToIntegerzh_fast)
532 #define RTS_LONG_LONG_SYMS /* nothing */
535 #ifdef ia64_TARGET_ARCH
536 /* force these symbols to be present */
537 #define RTS_EXTRA_SYMBOLS \
539 #elif defined(powerpc_TARGET_ARCH)
540 #define RTS_EXTRA_SYMBOLS \
550 #define RTS_EXTRA_SYMBOLS /* nothing */
553 /* entirely bogus claims about types of these symbols */
554 #define Sym(vvv) extern void (vvv);
555 #define SymX(vvv) /**/
559 RTS_POSIX_ONLY_SYMBOLS
560 RTS_MINGW_ONLY_SYMBOLS
561 RTS_CYGWIN_ONLY_SYMBOLS
565 #ifdef LEADING_UNDERSCORE
566 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
568 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
571 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
573 #define SymX(vvv) Sym(vvv)
575 static RtsSymbolVal rtsSyms[] = {
579 RTS_POSIX_ONLY_SYMBOLS
580 RTS_MINGW_ONLY_SYMBOLS
581 RTS_CYGWIN_ONLY_SYMBOLS
582 { 0, 0 } /* sentinel */
585 /* -----------------------------------------------------------------------------
586 * Insert symbols into hash tables, checking for duplicates.
588 static void ghciInsertStrHashTable ( char* obj_name,
594 if (lookupHashTable(table, (StgWord)key) == NULL)
596 insertStrHashTable(table, (StgWord)key, data);
601 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
603 "whilst processing object file\n"
605 "This could be caused by:\n"
606 " * Loading two different object files which export the same symbol\n"
607 " * Specifying the same object file twice on the GHCi command line\n"
608 " * An incorrect `package.conf' entry, causing some object to be\n"
610 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
619 /* -----------------------------------------------------------------------------
620 * initialize the object linker
624 static int linker_init_done = 0 ;
626 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
627 static void *dl_prog_handle;
635 /* Make initLinker idempotent, so we can call it
636 before evey relevant operation; that means we
637 don't need to initialise the linker separately */
638 if (linker_init_done == 1) { return; } else {
639 linker_init_done = 1;
642 symhash = allocStrHashTable();
644 /* populate the symbol table with stuff from the RTS */
645 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
646 ghciInsertStrHashTable("(GHCi built-in symbols)",
647 symhash, sym->lbl, sym->addr);
649 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
650 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
654 /* -----------------------------------------------------------------------------
655 * Loading DLL or .so dynamic libraries
656 * -----------------------------------------------------------------------------
658 * Add a DLL from which symbols may be found. In the ELF case, just
659 * do RTLD_GLOBAL-style add, so no further messing around needs to
660 * happen in order that symbols in the loaded .so are findable --
661 * lookupSymbol() will subsequently see them by dlsym on the program's
662 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
664 * In the PEi386 case, open the DLLs and put handles to them in a
665 * linked list. When looking for a symbol, try all handles in the
666 * list. This means that we need to load even DLLs that are guaranteed
667 * to be in the ghc.exe image already, just so we can get a handle
668 * to give to loadSymbol, so that we can find the symbols. For such
669 * libraries, the LoadLibrary call should be a no-op except for returning
674 #if defined(OBJFORMAT_PEi386)
675 /* A record for storing handles into DLLs. */
680 struct _OpenedDLL* next;
685 /* A list thereof. */
686 static OpenedDLL* opened_dlls = NULL;
690 addDLL( char *dll_name )
692 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
693 /* ------------------- ELF DLL loader ------------------- */
699 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
701 /* dlopen failed; return a ptr to the error msg. */
703 if (errmsg == NULL) errmsg = "addDLL: unknown error";
710 # elif defined(OBJFORMAT_PEi386)
711 /* ------------------- Win32 DLL loader ------------------- */
719 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
721 /* See if we've already got it, and ignore if so. */
722 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
723 if (0 == strcmp(o_dll->name, dll_name))
727 /* The file name has no suffix (yet) so that we can try
728 both foo.dll and foo.drv
730 The documentation for LoadLibrary says:
731 If no file name extension is specified in the lpFileName
732 parameter, the default library extension .dll is
733 appended. However, the file name string can include a trailing
734 point character (.) to indicate that the module name has no
737 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
738 sprintf(buf, "%s.DLL", dll_name);
739 instance = LoadLibrary(buf);
740 if (instance == NULL) {
741 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
742 instance = LoadLibrary(buf);
743 if (instance == NULL) {
746 /* LoadLibrary failed; return a ptr to the error msg. */
747 return "addDLL: unknown error";
752 /* Add this DLL to the list of DLLs in which to search for symbols. */
753 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
754 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
755 strcpy(o_dll->name, dll_name);
756 o_dll->instance = instance;
757 o_dll->next = opened_dlls;
762 barf("addDLL: not implemented on this platform");
766 /* -----------------------------------------------------------------------------
767 * lookup a symbol in the hash table
770 lookupSymbol( char *lbl )
774 ASSERT(symhash != NULL);
775 val = lookupStrHashTable(symhash, lbl);
778 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
779 return dlsym(dl_prog_handle, lbl);
780 # elif defined(OBJFORMAT_PEi386)
783 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
784 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
786 /* HACK: if the name has an initial underscore, try stripping
787 it off & look that up first. I've yet to verify whether there's
788 a Rule that governs whether an initial '_' *should always* be
789 stripped off when mapping from import lib name to the DLL name.
791 sym = GetProcAddress(o_dll->instance, (lbl+1));
793 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
797 sym = GetProcAddress(o_dll->instance, lbl);
799 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
814 __attribute((unused))
816 lookupLocalSymbol( ObjectCode* oc, char *lbl )
820 val = lookupStrHashTable(oc->lochash, lbl);
830 /* -----------------------------------------------------------------------------
831 * Debugging aid: look in GHCi's object symbol tables for symbols
832 * within DELTA bytes of the specified address, and show their names.
835 void ghci_enquire ( char* addr );
837 void ghci_enquire ( char* addr )
842 const int DELTA = 64;
847 for (oc = objects; oc; oc = oc->next) {
848 for (i = 0; i < oc->n_symbols; i++) {
849 sym = oc->symbols[i];
850 if (sym == NULL) continue;
851 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
853 if (oc->lochash != NULL) {
854 a = lookupStrHashTable(oc->lochash, sym);
857 a = lookupStrHashTable(symhash, sym);
860 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
862 else if (addr-DELTA <= a && a <= addr+DELTA) {
863 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
870 #ifdef ia64_TARGET_ARCH
871 static unsigned int PLTSize(void);
874 /* -----------------------------------------------------------------------------
875 * Load an obj (populate the global symbol table, but don't resolve yet)
877 * Returns: 1 if ok, 0 on error.
880 loadObj( char *path )
894 /* fprintf(stderr, "loadObj %s\n", path ); */
896 /* Check that we haven't already loaded this object. Don't give up
897 at this stage; ocGetNames_* will barf later. */
901 for (o = objects; o; o = o->next) {
902 if (0 == strcmp(o->fileName, path))
908 "GHCi runtime linker: warning: looks like you're trying to load the\n"
909 "same object file twice:\n"
911 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
917 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
919 # if defined(OBJFORMAT_ELF)
920 oc->formatName = "ELF";
921 # elif defined(OBJFORMAT_PEi386)
922 oc->formatName = "PEi386";
923 # elif defined(OBJFORMAT_MACHO)
924 oc->formatName = "Mach-O";
927 barf("loadObj: not implemented on this platform");
931 if (r == -1) { return 0; }
933 /* sigh, strdup() isn't a POSIX function, so do it the long way */
934 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
935 strcpy(oc->fileName, path);
937 oc->fileSize = st.st_size;
940 oc->lochash = allocStrHashTable();
941 oc->proddables = NULL;
943 /* chain it onto the list of objects */
948 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
950 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
952 fd = open(path, O_RDONLY);
954 barf("loadObj: can't open `%s'", path);
956 pagesize = getpagesize();
958 #ifdef ia64_TARGET_ARCH
959 /* The PLT needs to be right before the object */
960 n = ROUND_UP(PLTSize(), pagesize);
961 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
962 if (oc->plt == MAP_FAILED)
963 barf("loadObj: can't allocate PLT");
966 map_addr = oc->plt + n;
969 n = ROUND_UP(oc->fileSize, pagesize);
970 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
971 if (oc->image == MAP_FAILED)
972 barf("loadObj: can't map `%s'", path);
976 #else /* !USE_MMAP */
978 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
980 /* load the image into memory */
981 f = fopen(path, "rb");
983 barf("loadObj: can't read `%s'", path);
985 n = fread ( oc->image, 1, oc->fileSize, f );
986 if (n != oc->fileSize)
987 barf("loadObj: error whilst reading `%s'", path);
991 #endif /* USE_MMAP */
993 /* verify the in-memory image */
994 # if defined(OBJFORMAT_ELF)
995 r = ocVerifyImage_ELF ( oc );
996 # elif defined(OBJFORMAT_PEi386)
997 r = ocVerifyImage_PEi386 ( oc );
998 # elif defined(OBJFORMAT_MACHO)
999 r = ocVerifyImage_MachO ( oc );
1001 barf("loadObj: no verify method");
1003 if (!r) { return r; }
1005 /* build the symbol list for this image */
1006 # if defined(OBJFORMAT_ELF)
1007 r = ocGetNames_ELF ( oc );
1008 # elif defined(OBJFORMAT_PEi386)
1009 r = ocGetNames_PEi386 ( oc );
1010 # elif defined(OBJFORMAT_MACHO)
1011 r = ocGetNames_MachO ( oc );
1013 barf("loadObj: no getNames method");
1015 if (!r) { return r; }
1017 /* loaded, but not resolved yet */
1018 oc->status = OBJECT_LOADED;
1023 /* -----------------------------------------------------------------------------
1024 * resolve all the currently unlinked objects in memory
1026 * Returns: 1 if ok, 0 on error.
1036 for (oc = objects; oc; oc = oc->next) {
1037 if (oc->status != OBJECT_RESOLVED) {
1038 # if defined(OBJFORMAT_ELF)
1039 r = ocResolve_ELF ( oc );
1040 # elif defined(OBJFORMAT_PEi386)
1041 r = ocResolve_PEi386 ( oc );
1042 # elif defined(OBJFORMAT_MACHO)
1043 r = ocResolve_MachO ( oc );
1045 barf("resolveObjs: not implemented on this platform");
1047 if (!r) { return r; }
1048 oc->status = OBJECT_RESOLVED;
1054 /* -----------------------------------------------------------------------------
1055 * delete an object from the pool
1058 unloadObj( char *path )
1060 ObjectCode *oc, *prev;
1062 ASSERT(symhash != NULL);
1063 ASSERT(objects != NULL);
1068 for (oc = objects; oc; prev = oc, oc = oc->next) {
1069 if (!strcmp(oc->fileName,path)) {
1071 /* Remove all the mappings for the symbols within this
1076 for (i = 0; i < oc->n_symbols; i++) {
1077 if (oc->symbols[i] != NULL) {
1078 removeStrHashTable(symhash, oc->symbols[i], NULL);
1086 prev->next = oc->next;
1089 /* We're going to leave this in place, in case there are
1090 any pointers from the heap into it: */
1091 /* free(oc->image); */
1095 /* The local hash table should have been freed at the end
1096 of the ocResolve_ call on it. */
1097 ASSERT(oc->lochash == NULL);
1103 belch("unloadObj: can't find `%s' to unload", path);
1107 /* -----------------------------------------------------------------------------
1108 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1109 * which may be prodded during relocation, and abort if we try and write
1110 * outside any of these.
1112 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1115 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1116 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1120 pb->next = oc->proddables;
1121 oc->proddables = pb;
1124 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1127 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1128 char* s = (char*)(pb->start);
1129 char* e = s + pb->size - 1;
1130 char* a = (char*)addr;
1131 /* Assumes that the biggest fixup involves a 4-byte write. This
1132 probably needs to be changed to 8 (ie, +7) on 64-bit
1134 if (a >= s && (a+3) <= e) return;
1136 barf("checkProddableBlock: invalid fixup in runtime linker");
1139 /* -----------------------------------------------------------------------------
1140 * Section management.
1142 static void addSection ( ObjectCode* oc, SectionKind kind,
1143 void* start, void* end )
1145 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1149 s->next = oc->sections;
1152 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1153 start, ((char*)end)-1, end - start + 1, kind );
1159 /* --------------------------------------------------------------------------
1160 * PEi386 specifics (Win32 targets)
1161 * ------------------------------------------------------------------------*/
1163 /* The information for this linker comes from
1164 Microsoft Portable Executable
1165 and Common Object File Format Specification
1166 revision 5.1 January 1998
1167 which SimonM says comes from the MS Developer Network CDs.
1169 It can be found there (on older CDs), but can also be found
1172 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1174 (this is Rev 6.0 from February 1999).
1176 Things move, so if that fails, try searching for it via
1178 http://www.google.com/search?q=PE+COFF+specification
1180 The ultimate reference for the PE format is the Winnt.h
1181 header file that comes with the Platform SDKs; as always,
1182 implementations will drift wrt their documentation.
1184 A good background article on the PE format is Matt Pietrek's
1185 March 1994 article in Microsoft System Journal (MSJ)
1186 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1187 Win32 Portable Executable File Format." The info in there
1188 has recently been updated in a two part article in
1189 MSDN magazine, issues Feb and March 2002,
1190 "Inside Windows: An In-Depth Look into the Win32 Portable
1191 Executable File Format"
1193 John Levine's book "Linkers and Loaders" contains useful
1198 #if defined(OBJFORMAT_PEi386)
1202 typedef unsigned char UChar;
1203 typedef unsigned short UInt16;
1204 typedef unsigned int UInt32;
1211 UInt16 NumberOfSections;
1212 UInt32 TimeDateStamp;
1213 UInt32 PointerToSymbolTable;
1214 UInt32 NumberOfSymbols;
1215 UInt16 SizeOfOptionalHeader;
1216 UInt16 Characteristics;
1220 #define sizeof_COFF_header 20
1227 UInt32 VirtualAddress;
1228 UInt32 SizeOfRawData;
1229 UInt32 PointerToRawData;
1230 UInt32 PointerToRelocations;
1231 UInt32 PointerToLinenumbers;
1232 UInt16 NumberOfRelocations;
1233 UInt16 NumberOfLineNumbers;
1234 UInt32 Characteristics;
1238 #define sizeof_COFF_section 40
1245 UInt16 SectionNumber;
1248 UChar NumberOfAuxSymbols;
1252 #define sizeof_COFF_symbol 18
1257 UInt32 VirtualAddress;
1258 UInt32 SymbolTableIndex;
1263 #define sizeof_COFF_reloc 10
1266 /* From PE spec doc, section 3.3.2 */
1267 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1268 windows.h -- for the same purpose, but I want to know what I'm
1270 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1271 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1272 #define MYIMAGE_FILE_DLL 0x2000
1273 #define MYIMAGE_FILE_SYSTEM 0x1000
1274 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1275 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1276 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1278 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1279 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1280 #define MYIMAGE_SYM_CLASS_STATIC 3
1281 #define MYIMAGE_SYM_UNDEFINED 0
1283 /* From PE spec doc, section 4.1 */
1284 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1285 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1286 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1288 /* From PE spec doc, section 5.2.1 */
1289 #define MYIMAGE_REL_I386_DIR32 0x0006
1290 #define MYIMAGE_REL_I386_REL32 0x0014
1293 /* We use myindex to calculate array addresses, rather than
1294 simply doing the normal subscript thing. That's because
1295 some of the above structs have sizes which are not
1296 a whole number of words. GCC rounds their sizes up to a
1297 whole number of words, which means that the address calcs
1298 arising from using normal C indexing or pointer arithmetic
1299 are just plain wrong. Sigh.
1302 myindex ( int scale, void* base, int index )
1305 ((UChar*)base) + scale * index;
1310 printName ( UChar* name, UChar* strtab )
1312 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1313 UInt32 strtab_offset = * (UInt32*)(name+4);
1314 fprintf ( stderr, "%s", strtab + strtab_offset );
1317 for (i = 0; i < 8; i++) {
1318 if (name[i] == 0) break;
1319 fprintf ( stderr, "%c", name[i] );
1326 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1328 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1329 UInt32 strtab_offset = * (UInt32*)(name+4);
1330 strncpy ( dst, strtab+strtab_offset, dstSize );
1336 if (name[i] == 0) break;
1346 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1349 /* If the string is longer than 8 bytes, look in the
1350 string table for it -- this will be correctly zero terminated.
1352 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1353 UInt32 strtab_offset = * (UInt32*)(name+4);
1354 return ((UChar*)strtab) + strtab_offset;
1356 /* Otherwise, if shorter than 8 bytes, return the original,
1357 which by defn is correctly terminated.
1359 if (name[7]==0) return name;
1360 /* The annoying case: 8 bytes. Copy into a temporary
1361 (which is never freed ...)
1363 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1365 strncpy(newstr,name,8);
1371 /* Just compares the short names (first 8 chars) */
1372 static COFF_section *
1373 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1377 = (COFF_header*)(oc->image);
1378 COFF_section* sectab
1380 ((UChar*)(oc->image))
1381 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1383 for (i = 0; i < hdr->NumberOfSections; i++) {
1386 COFF_section* section_i
1388 myindex ( sizeof_COFF_section, sectab, i );
1389 n1 = (UChar*) &(section_i->Name);
1391 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1392 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1393 n1[6]==n2[6] && n1[7]==n2[7])
1402 zapTrailingAtSign ( UChar* sym )
1404 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1406 if (sym[0] == 0) return;
1408 while (sym[i] != 0) i++;
1411 while (j > 0 && my_isdigit(sym[j])) j--;
1412 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1418 ocVerifyImage_PEi386 ( ObjectCode* oc )
1423 COFF_section* sectab;
1424 COFF_symbol* symtab;
1426 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1427 hdr = (COFF_header*)(oc->image);
1428 sectab = (COFF_section*) (
1429 ((UChar*)(oc->image))
1430 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1432 symtab = (COFF_symbol*) (
1433 ((UChar*)(oc->image))
1434 + hdr->PointerToSymbolTable
1436 strtab = ((UChar*)symtab)
1437 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1439 if (hdr->Machine != 0x14c) {
1440 belch("Not x86 PEi386");
1443 if (hdr->SizeOfOptionalHeader != 0) {
1444 belch("PEi386 with nonempty optional header");
1447 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1448 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1449 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1450 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1451 belch("Not a PEi386 object file");
1454 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1455 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1456 belch("Invalid PEi386 word size or endiannness: %d",
1457 (int)(hdr->Characteristics));
1460 /* If the string table size is way crazy, this might indicate that
1461 there are more than 64k relocations, despite claims to the
1462 contrary. Hence this test. */
1463 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1465 if ( (*(UInt32*)strtab) > 600000 ) {
1466 /* Note that 600k has no special significance other than being
1467 big enough to handle the almost-2MB-sized lumps that
1468 constitute HSwin32*.o. */
1469 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1474 /* No further verification after this point; only debug printing. */
1476 IF_DEBUG(linker, i=1);
1477 if (i == 0) return 1;
1480 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1482 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1484 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1486 fprintf ( stderr, "\n" );
1488 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1490 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1492 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1494 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1496 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1498 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1500 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1502 /* Print the section table. */
1503 fprintf ( stderr, "\n" );
1504 for (i = 0; i < hdr->NumberOfSections; i++) {
1506 COFF_section* sectab_i
1508 myindex ( sizeof_COFF_section, sectab, i );
1515 printName ( sectab_i->Name, strtab );
1525 sectab_i->VirtualSize,
1526 sectab_i->VirtualAddress,
1527 sectab_i->SizeOfRawData,
1528 sectab_i->PointerToRawData,
1529 sectab_i->NumberOfRelocations,
1530 sectab_i->PointerToRelocations,
1531 sectab_i->PointerToRawData
1533 reltab = (COFF_reloc*) (
1534 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1537 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1538 /* If the relocation field (a short) has overflowed, the
1539 * real count can be found in the first reloc entry.
1541 * See Section 4.1 (last para) of the PE spec (rev6.0).
1543 COFF_reloc* rel = (COFF_reloc*)
1544 myindex ( sizeof_COFF_reloc, reltab, 0 );
1545 noRelocs = rel->VirtualAddress;
1548 noRelocs = sectab_i->NumberOfRelocations;
1552 for (; j < noRelocs; j++) {
1554 COFF_reloc* rel = (COFF_reloc*)
1555 myindex ( sizeof_COFF_reloc, reltab, j );
1557 " type 0x%-4x vaddr 0x%-8x name `",
1559 rel->VirtualAddress );
1560 sym = (COFF_symbol*)
1561 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1562 /* Hmm..mysterious looking offset - what's it for? SOF */
1563 printName ( sym->Name, strtab -10 );
1564 fprintf ( stderr, "'\n" );
1567 fprintf ( stderr, "\n" );
1569 fprintf ( stderr, "\n" );
1570 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1571 fprintf ( stderr, "---START of string table---\n");
1572 for (i = 4; i < *(Int32*)strtab; i++) {
1574 fprintf ( stderr, "\n"); else
1575 fprintf( stderr, "%c", strtab[i] );
1577 fprintf ( stderr, "--- END of string table---\n");
1579 fprintf ( stderr, "\n" );
1582 COFF_symbol* symtab_i;
1583 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1584 symtab_i = (COFF_symbol*)
1585 myindex ( sizeof_COFF_symbol, symtab, i );
1591 printName ( symtab_i->Name, strtab );
1600 (Int32)(symtab_i->SectionNumber),
1601 (UInt32)symtab_i->Type,
1602 (UInt32)symtab_i->StorageClass,
1603 (UInt32)symtab_i->NumberOfAuxSymbols
1605 i += symtab_i->NumberOfAuxSymbols;
1609 fprintf ( stderr, "\n" );
1615 ocGetNames_PEi386 ( ObjectCode* oc )
1618 COFF_section* sectab;
1619 COFF_symbol* symtab;
1626 hdr = (COFF_header*)(oc->image);
1627 sectab = (COFF_section*) (
1628 ((UChar*)(oc->image))
1629 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1631 symtab = (COFF_symbol*) (
1632 ((UChar*)(oc->image))
1633 + hdr->PointerToSymbolTable
1635 strtab = ((UChar*)(oc->image))
1636 + hdr->PointerToSymbolTable
1637 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1639 /* Allocate space for any (local, anonymous) .bss sections. */
1641 for (i = 0; i < hdr->NumberOfSections; i++) {
1643 COFF_section* sectab_i
1645 myindex ( sizeof_COFF_section, sectab, i );
1646 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1647 if (sectab_i->VirtualSize == 0) continue;
1648 /* This is a non-empty .bss section. Allocate zeroed space for
1649 it, and set its PointerToRawData field such that oc->image +
1650 PointerToRawData == addr_of_zeroed_space. */
1651 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1652 "ocGetNames_PEi386(anonymous bss)");
1653 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1654 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1655 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1658 /* Copy section information into the ObjectCode. */
1660 for (i = 0; i < hdr->NumberOfSections; i++) {
1666 = SECTIONKIND_OTHER;
1667 COFF_section* sectab_i
1669 myindex ( sizeof_COFF_section, sectab, i );
1670 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1673 /* I'm sure this is the Right Way to do it. However, the
1674 alternative of testing the sectab_i->Name field seems to
1675 work ok with Cygwin.
1677 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1678 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1679 kind = SECTIONKIND_CODE_OR_RODATA;
1682 if (0==strcmp(".text",sectab_i->Name) ||
1683 0==strcmp(".rodata",sectab_i->Name))
1684 kind = SECTIONKIND_CODE_OR_RODATA;
1685 if (0==strcmp(".data",sectab_i->Name) ||
1686 0==strcmp(".bss",sectab_i->Name))
1687 kind = SECTIONKIND_RWDATA;
1689 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1690 sz = sectab_i->SizeOfRawData;
1691 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1693 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1694 end = start + sz - 1;
1696 if (kind == SECTIONKIND_OTHER
1697 /* Ignore sections called which contain stabs debugging
1699 && 0 != strcmp(".stab", sectab_i->Name)
1700 && 0 != strcmp(".stabstr", sectab_i->Name)
1702 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1706 if (kind != SECTIONKIND_OTHER && end >= start) {
1707 addSection(oc, kind, start, end);
1708 addProddableBlock(oc, start, end - start + 1);
1712 /* Copy exported symbols into the ObjectCode. */
1714 oc->n_symbols = hdr->NumberOfSymbols;
1715 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1716 "ocGetNames_PEi386(oc->symbols)");
1717 /* Call me paranoid; I don't care. */
1718 for (i = 0; i < oc->n_symbols; i++)
1719 oc->symbols[i] = NULL;
1723 COFF_symbol* symtab_i;
1724 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1725 symtab_i = (COFF_symbol*)
1726 myindex ( sizeof_COFF_symbol, symtab, i );
1730 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1731 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1732 /* This symbol is global and defined, viz, exported */
1733 /* for MYIMAGE_SYMCLASS_EXTERNAL
1734 && !MYIMAGE_SYM_UNDEFINED,
1735 the address of the symbol is:
1736 address of relevant section + offset in section
1738 COFF_section* sectabent
1739 = (COFF_section*) myindex ( sizeof_COFF_section,
1741 symtab_i->SectionNumber-1 );
1742 addr = ((UChar*)(oc->image))
1743 + (sectabent->PointerToRawData
1747 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1748 && symtab_i->Value > 0) {
1749 /* This symbol isn't in any section at all, ie, global bss.
1750 Allocate zeroed space for it. */
1751 addr = stgCallocBytes(1, symtab_i->Value,
1752 "ocGetNames_PEi386(non-anonymous bss)");
1753 addSection(oc, SECTIONKIND_RWDATA, addr,
1754 ((UChar*)addr) + symtab_i->Value - 1);
1755 addProddableBlock(oc, addr, symtab_i->Value);
1756 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1759 if (addr != NULL ) {
1760 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1761 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1762 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1763 ASSERT(i >= 0 && i < oc->n_symbols);
1764 /* cstring_from_COFF_symbol_name always succeeds. */
1765 oc->symbols[i] = sname;
1766 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1770 "IGNORING symbol %d\n"
1774 printName ( symtab_i->Name, strtab );
1783 (Int32)(symtab_i->SectionNumber),
1784 (UInt32)symtab_i->Type,
1785 (UInt32)symtab_i->StorageClass,
1786 (UInt32)symtab_i->NumberOfAuxSymbols
1791 i += symtab_i->NumberOfAuxSymbols;
1800 ocResolve_PEi386 ( ObjectCode* oc )
1803 COFF_section* sectab;
1804 COFF_symbol* symtab;
1814 /* ToDo: should be variable-sized? But is at least safe in the
1815 sense of buffer-overrun-proof. */
1817 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1819 hdr = (COFF_header*)(oc->image);
1820 sectab = (COFF_section*) (
1821 ((UChar*)(oc->image))
1822 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1824 symtab = (COFF_symbol*) (
1825 ((UChar*)(oc->image))
1826 + hdr->PointerToSymbolTable
1828 strtab = ((UChar*)(oc->image))
1829 + hdr->PointerToSymbolTable
1830 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1832 for (i = 0; i < hdr->NumberOfSections; i++) {
1833 COFF_section* sectab_i
1835 myindex ( sizeof_COFF_section, sectab, i );
1838 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1841 /* Ignore sections called which contain stabs debugging
1843 if (0 == strcmp(".stab", sectab_i->Name)
1844 || 0 == strcmp(".stabstr", sectab_i->Name))
1847 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1848 /* If the relocation field (a short) has overflowed, the
1849 * real count can be found in the first reloc entry.
1851 * See Section 4.1 (last para) of the PE spec (rev6.0).
1853 COFF_reloc* rel = (COFF_reloc*)
1854 myindex ( sizeof_COFF_reloc, reltab, 0 );
1855 noRelocs = rel->VirtualAddress;
1856 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1859 noRelocs = sectab_i->NumberOfRelocations;
1864 for (; j < noRelocs; j++) {
1866 COFF_reloc* reltab_j
1868 myindex ( sizeof_COFF_reloc, reltab, j );
1870 /* the location to patch */
1872 ((UChar*)(oc->image))
1873 + (sectab_i->PointerToRawData
1874 + reltab_j->VirtualAddress
1875 - sectab_i->VirtualAddress )
1877 /* the existing contents of pP */
1879 /* the symbol to connect to */
1880 sym = (COFF_symbol*)
1881 myindex ( sizeof_COFF_symbol,
1882 symtab, reltab_j->SymbolTableIndex );
1885 "reloc sec %2d num %3d: type 0x%-4x "
1886 "vaddr 0x%-8x name `",
1888 (UInt32)reltab_j->Type,
1889 reltab_j->VirtualAddress );
1890 printName ( sym->Name, strtab );
1891 fprintf ( stderr, "'\n" ));
1893 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1894 COFF_section* section_sym
1895 = findPEi386SectionCalled ( oc, sym->Name );
1897 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1900 S = ((UInt32)(oc->image))
1901 + (section_sym->PointerToRawData
1904 copyName ( sym->Name, strtab, symbol, 1000-1 );
1905 (void*)S = lookupLocalSymbol( oc, symbol );
1906 if ((void*)S != NULL) goto foundit;
1907 (void*)S = lookupSymbol( symbol );
1908 if ((void*)S != NULL) goto foundit;
1909 zapTrailingAtSign ( symbol );
1910 (void*)S = lookupLocalSymbol( oc, symbol );
1911 if ((void*)S != NULL) goto foundit;
1912 (void*)S = lookupSymbol( symbol );
1913 if ((void*)S != NULL) goto foundit;
1914 /* Newline first because the interactive linker has printed "linking..." */
1915 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1919 checkProddableBlock(oc, pP);
1920 switch (reltab_j->Type) {
1921 case MYIMAGE_REL_I386_DIR32:
1924 case MYIMAGE_REL_I386_REL32:
1925 /* Tricky. We have to insert a displacement at
1926 pP which, when added to the PC for the _next_
1927 insn, gives the address of the target (S).
1928 Problem is to know the address of the next insn
1929 when we only know pP. We assume that this
1930 literal field is always the last in the insn,
1931 so that the address of the next insn is pP+4
1932 -- hence the constant 4.
1933 Also I don't know if A should be added, but so
1934 far it has always been zero.
1937 *pP = S - ((UInt32)pP) - 4;
1940 belch("%s: unhandled PEi386 relocation type %d",
1941 oc->fileName, reltab_j->Type);
1948 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1952 #endif /* defined(OBJFORMAT_PEi386) */
1955 /* --------------------------------------------------------------------------
1957 * ------------------------------------------------------------------------*/
1959 #if defined(OBJFORMAT_ELF)
1964 #if defined(sparc_TARGET_ARCH)
1965 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1966 #elif defined(i386_TARGET_ARCH)
1967 # define ELF_TARGET_386 /* Used inside <elf.h> */
1968 #elif defined (ia64_TARGET_ARCH)
1969 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
1971 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
1972 # define ELF_NEED_GOT /* needs Global Offset Table */
1973 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
1979 * Define a set of types which can be used for both ELF32 and ELF64
1983 #define ELFCLASS ELFCLASS64
1984 #define Elf_Addr Elf64_Addr
1985 #define Elf_Word Elf64_Word
1986 #define Elf_Sword Elf64_Sword
1987 #define Elf_Ehdr Elf64_Ehdr
1988 #define Elf_Phdr Elf64_Phdr
1989 #define Elf_Shdr Elf64_Shdr
1990 #define Elf_Sym Elf64_Sym
1991 #define Elf_Rel Elf64_Rel
1992 #define Elf_Rela Elf64_Rela
1993 #define ELF_ST_TYPE ELF64_ST_TYPE
1994 #define ELF_ST_BIND ELF64_ST_BIND
1995 #define ELF_R_TYPE ELF64_R_TYPE
1996 #define ELF_R_SYM ELF64_R_SYM
1998 #define ELFCLASS ELFCLASS32
1999 #define Elf_Addr Elf32_Addr
2000 #define Elf_Word Elf32_Word
2001 #define Elf_Sword Elf32_Sword
2002 #define Elf_Ehdr Elf32_Ehdr
2003 #define Elf_Phdr Elf32_Phdr
2004 #define Elf_Shdr Elf32_Shdr
2005 #define Elf_Sym Elf32_Sym
2006 #define Elf_Rel Elf32_Rel
2007 #define Elf_Rela Elf32_Rela
2008 #define ELF_ST_TYPE ELF32_ST_TYPE
2009 #define ELF_ST_BIND ELF32_ST_BIND
2010 #define ELF_R_TYPE ELF32_R_TYPE
2011 #define ELF_R_SYM ELF32_R_SYM
2016 * Functions to allocate entries in dynamic sections. Currently we simply
2017 * preallocate a large number, and we don't check if a entry for the given
2018 * target already exists (a linear search is too slow). Ideally these
2019 * entries would be associated with symbols.
2022 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2023 #define GOT_SIZE 0x20000
2024 #define FUNCTION_TABLE_SIZE 0x10000
2025 #define PLT_SIZE 0x08000
2028 static Elf_Addr got[GOT_SIZE];
2029 static unsigned int gotIndex;
2030 static Elf_Addr gp_val = (Elf_Addr)got;
2033 allocateGOTEntry(Elf_Addr target)
2037 if (gotIndex >= GOT_SIZE)
2038 barf("Global offset table overflow");
2040 entry = &got[gotIndex++];
2042 return (Elf_Addr)entry;
2046 #ifdef ELF_FUNCTION_DESC
2052 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2053 static unsigned int functionTableIndex;
2056 allocateFunctionDesc(Elf_Addr target)
2058 FunctionDesc *entry;
2060 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2061 barf("Function table overflow");
2063 entry = &functionTable[functionTableIndex++];
2065 entry->gp = (Elf_Addr)gp_val;
2066 return (Elf_Addr)entry;
2070 copyFunctionDesc(Elf_Addr target)
2072 FunctionDesc *olddesc = (FunctionDesc *)target;
2073 FunctionDesc *newdesc;
2075 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2076 newdesc->gp = olddesc->gp;
2077 return (Elf_Addr)newdesc;
2082 #ifdef ia64_TARGET_ARCH
2083 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2084 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2086 static unsigned char plt_code[] =
2088 /* taken from binutils bfd/elfxx-ia64.c */
2089 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2090 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2091 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2092 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2093 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2094 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2097 /* If we can't get to the function descriptor via gp, take a local copy of it */
2098 #define PLT_RELOC(code, target) { \
2099 Elf64_Sxword rel_value = target - gp_val; \
2100 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2101 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2103 ia64_reloc_gprel22((Elf_Addr)code, target); \
2108 unsigned char code[sizeof(plt_code)];
2112 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2114 PLTEntry *plt = (PLTEntry *)oc->plt;
2117 if (oc->pltIndex >= PLT_SIZE)
2118 barf("Procedure table overflow");
2120 entry = &plt[oc->pltIndex++];
2121 memcpy(entry->code, plt_code, sizeof(entry->code));
2122 PLT_RELOC(entry->code, target);
2123 return (Elf_Addr)entry;
2129 return (PLT_SIZE * sizeof(PLTEntry));
2135 * Generic ELF functions
2139 findElfSection ( void* objImage, Elf_Word sh_type )
2141 char* ehdrC = (char*)objImage;
2142 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2143 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2144 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2148 for (i = 0; i < ehdr->e_shnum; i++) {
2149 if (shdr[i].sh_type == sh_type
2150 /* Ignore the section header's string table. */
2151 && i != ehdr->e_shstrndx
2152 /* Ignore string tables named .stabstr, as they contain
2154 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2156 ptr = ehdrC + shdr[i].sh_offset;
2163 #if defined(ia64_TARGET_ARCH)
2165 findElfSegment ( void* objImage, Elf_Addr vaddr )
2167 char* ehdrC = (char*)objImage;
2168 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2169 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2170 Elf_Addr segaddr = 0;
2173 for (i = 0; i < ehdr->e_phnum; i++) {
2174 segaddr = phdr[i].p_vaddr;
2175 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2183 ocVerifyImage_ELF ( ObjectCode* oc )
2187 int i, j, nent, nstrtab, nsymtabs;
2191 char* ehdrC = (char*)(oc->image);
2192 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2194 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2195 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2196 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2197 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2198 belch("%s: not an ELF object", oc->fileName);
2202 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2203 belch("%s: unsupported ELF format", oc->fileName);
2207 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2208 IF_DEBUG(linker,belch( "Is little-endian" ));
2210 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2211 IF_DEBUG(linker,belch( "Is big-endian" ));
2213 belch("%s: unknown endiannness", oc->fileName);
2217 if (ehdr->e_type != ET_REL) {
2218 belch("%s: not a relocatable object (.o) file", oc->fileName);
2221 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2223 IF_DEBUG(linker,belch( "Architecture is " ));
2224 switch (ehdr->e_machine) {
2225 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2226 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2228 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2230 default: IF_DEBUG(linker,belch( "unknown" ));
2231 belch("%s: unknown architecture", oc->fileName);
2235 IF_DEBUG(linker,belch(
2236 "\nSection header table: start %d, n_entries %d, ent_size %d",
2237 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2239 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2241 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2243 if (ehdr->e_shstrndx == SHN_UNDEF) {
2244 belch("%s: no section header string table", oc->fileName);
2247 IF_DEBUG(linker,belch( "Section header string table is section %d",
2249 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2252 for (i = 0; i < ehdr->e_shnum; i++) {
2253 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2254 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2255 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2256 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2257 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2258 ehdrC + shdr[i].sh_offset,
2259 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2261 if (shdr[i].sh_type == SHT_REL) {
2262 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2263 } else if (shdr[i].sh_type == SHT_RELA) {
2264 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2266 IF_DEBUG(linker,fprintf(stderr," "));
2269 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2273 IF_DEBUG(linker,belch( "\nString tables" ));
2276 for (i = 0; i < ehdr->e_shnum; i++) {
2277 if (shdr[i].sh_type == SHT_STRTAB
2278 /* Ignore the section header's string table. */
2279 && i != ehdr->e_shstrndx
2280 /* Ignore string tables named .stabstr, as they contain
2282 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2284 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2285 strtab = ehdrC + shdr[i].sh_offset;
2290 belch("%s: no string tables, or too many", oc->fileName);
2295 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2296 for (i = 0; i < ehdr->e_shnum; i++) {
2297 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2298 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2300 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2301 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2302 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2304 shdr[i].sh_size % sizeof(Elf_Sym)
2306 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2307 belch("%s: non-integral number of symbol table entries", oc->fileName);
2310 for (j = 0; j < nent; j++) {
2311 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2312 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2313 (int)stab[j].st_shndx,
2314 (int)stab[j].st_size,
2315 (char*)stab[j].st_value ));
2317 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2318 switch (ELF_ST_TYPE(stab[j].st_info)) {
2319 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2320 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2321 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2322 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2323 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2324 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2326 IF_DEBUG(linker,fprintf(stderr, " " ));
2328 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2329 switch (ELF_ST_BIND(stab[j].st_info)) {
2330 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2331 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2332 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2333 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2335 IF_DEBUG(linker,fprintf(stderr, " " ));
2337 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2341 if (nsymtabs == 0) {
2342 belch("%s: didn't find any symbol tables", oc->fileName);
2351 ocGetNames_ELF ( ObjectCode* oc )
2356 char* ehdrC = (char*)(oc->image);
2357 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2358 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2359 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2361 ASSERT(symhash != NULL);
2364 belch("%s: no strtab", oc->fileName);
2369 for (i = 0; i < ehdr->e_shnum; i++) {
2370 /* Figure out what kind of section it is. Logic derived from
2371 Figure 1.14 ("Special Sections") of the ELF document
2372 ("Portable Formats Specification, Version 1.1"). */
2373 Elf_Shdr hdr = shdr[i];
2374 SectionKind kind = SECTIONKIND_OTHER;
2377 if (hdr.sh_type == SHT_PROGBITS
2378 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2379 /* .text-style section */
2380 kind = SECTIONKIND_CODE_OR_RODATA;
2383 if (hdr.sh_type == SHT_PROGBITS
2384 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2385 /* .data-style section */
2386 kind = SECTIONKIND_RWDATA;
2389 if (hdr.sh_type == SHT_PROGBITS
2390 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2391 /* .rodata-style section */
2392 kind = SECTIONKIND_CODE_OR_RODATA;
2395 if (hdr.sh_type == SHT_NOBITS
2396 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2397 /* .bss-style section */
2398 kind = SECTIONKIND_RWDATA;
2402 if (is_bss && shdr[i].sh_size > 0) {
2403 /* This is a non-empty .bss section. Allocate zeroed space for
2404 it, and set its .sh_offset field such that
2405 ehdrC + .sh_offset == addr_of_zeroed_space. */
2406 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2407 "ocGetNames_ELF(BSS)");
2408 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2410 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2411 zspace, shdr[i].sh_size);
2415 /* fill in the section info */
2416 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2417 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2418 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2419 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2422 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2424 /* copy stuff into this module's object symbol table */
2425 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2426 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2428 oc->n_symbols = nent;
2429 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2430 "ocGetNames_ELF(oc->symbols)");
2432 for (j = 0; j < nent; j++) {
2434 char isLocal = FALSE; /* avoids uninit-var warning */
2436 char* nm = strtab + stab[j].st_name;
2437 int secno = stab[j].st_shndx;
2439 /* Figure out if we want to add it; if so, set ad to its
2440 address. Otherwise leave ad == NULL. */
2442 if (secno == SHN_COMMON) {
2444 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2446 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2447 stab[j].st_size, nm);
2449 /* Pointless to do addProddableBlock() for this area,
2450 since the linker should never poke around in it. */
2453 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2454 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2456 /* and not an undefined symbol */
2457 && stab[j].st_shndx != SHN_UNDEF
2458 /* and not in a "special section" */
2459 && stab[j].st_shndx < SHN_LORESERVE
2461 /* and it's a not a section or string table or anything silly */
2462 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2463 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2464 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2467 /* Section 0 is the undefined section, hence > and not >=. */
2468 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2470 if (shdr[secno].sh_type == SHT_NOBITS) {
2471 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2472 stab[j].st_size, stab[j].st_value, nm);
2475 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2476 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2479 #ifdef ELF_FUNCTION_DESC
2480 /* dlsym() and the initialisation table both give us function
2481 * descriptors, so to be consistent we store function descriptors
2482 * in the symbol table */
2483 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2484 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2486 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2487 ad, oc->fileName, nm ));
2492 /* And the decision is ... */
2496 oc->symbols[j] = nm;
2499 /* Ignore entirely. */
2501 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2505 IF_DEBUG(linker,belch( "skipping `%s'",
2506 strtab + stab[j].st_name ));
2509 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2510 (int)ELF_ST_BIND(stab[j].st_info),
2511 (int)ELF_ST_TYPE(stab[j].st_info),
2512 (int)stab[j].st_shndx,
2513 strtab + stab[j].st_name
2516 oc->symbols[j] = NULL;
2525 /* Do ELF relocations which lack an explicit addend. All x86-linux
2526 relocations appear to be of this form. */
2528 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2529 Elf_Shdr* shdr, int shnum,
2530 Elf_Sym* stab, char* strtab )
2535 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2536 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2537 int target_shndx = shdr[shnum].sh_info;
2538 int symtab_shndx = shdr[shnum].sh_link;
2540 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2541 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2542 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2543 target_shndx, symtab_shndx ));
2545 for (j = 0; j < nent; j++) {
2546 Elf_Addr offset = rtab[j].r_offset;
2547 Elf_Addr info = rtab[j].r_info;
2549 Elf_Addr P = ((Elf_Addr)targ) + offset;
2550 Elf_Word* pP = (Elf_Word*)P;
2555 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2556 j, (void*)offset, (void*)info ));
2558 IF_DEBUG(linker,belch( " ZERO" ));
2561 Elf_Sym sym = stab[ELF_R_SYM(info)];
2562 /* First see if it is a local symbol. */
2563 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2564 /* Yes, so we can get the address directly from the ELF symbol
2566 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2568 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2569 + stab[ELF_R_SYM(info)].st_value);
2572 /* No, so look up the name in our global table. */
2573 symbol = strtab + sym.st_name;
2574 (void*)S = lookupSymbol( symbol );
2577 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2580 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2583 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2584 (void*)P, (void*)S, (void*)A ));
2585 checkProddableBlock ( oc, pP );
2589 switch (ELF_R_TYPE(info)) {
2590 # ifdef i386_TARGET_ARCH
2591 case R_386_32: *pP = value; break;
2592 case R_386_PC32: *pP = value - P; break;
2595 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2596 oc->fileName, ELF_R_TYPE(info));
2604 /* Do ELF relocations for which explicit addends are supplied.
2605 sparc-solaris relocations appear to be of this form. */
2607 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2608 Elf_Shdr* shdr, int shnum,
2609 Elf_Sym* stab, char* strtab )
2614 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2615 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2616 int target_shndx = shdr[shnum].sh_info;
2617 int symtab_shndx = shdr[shnum].sh_link;
2619 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2620 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2621 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2622 target_shndx, symtab_shndx ));
2624 for (j = 0; j < nent; j++) {
2625 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2626 /* This #ifdef only serves to avoid unused-var warnings. */
2627 Elf_Addr offset = rtab[j].r_offset;
2628 Elf_Addr P = targ + offset;
2630 Elf_Addr info = rtab[j].r_info;
2631 Elf_Addr A = rtab[j].r_addend;
2634 # if defined(sparc_TARGET_ARCH)
2635 Elf_Word* pP = (Elf_Word*)P;
2637 # elif defined(ia64_TARGET_ARCH)
2638 Elf64_Xword *pP = (Elf64_Xword *)P;
2642 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2643 j, (void*)offset, (void*)info,
2646 IF_DEBUG(linker,belch( " ZERO" ));
2649 Elf_Sym sym = stab[ELF_R_SYM(info)];
2650 /* First see if it is a local symbol. */
2651 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2652 /* Yes, so we can get the address directly from the ELF symbol
2654 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2656 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2657 + stab[ELF_R_SYM(info)].st_value);
2658 #ifdef ELF_FUNCTION_DESC
2659 /* Make a function descriptor for this function */
2660 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2661 S = allocateFunctionDesc(S + A);
2666 /* No, so look up the name in our global table. */
2667 symbol = strtab + sym.st_name;
2668 (void*)S = lookupSymbol( symbol );
2670 #ifdef ELF_FUNCTION_DESC
2671 /* If a function, already a function descriptor - we would
2672 have to copy it to add an offset. */
2673 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2678 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2681 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2684 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2685 (void*)P, (void*)S, (void*)A ));
2686 /* checkProddableBlock ( oc, (void*)P ); */
2690 switch (ELF_R_TYPE(info)) {
2691 # if defined(sparc_TARGET_ARCH)
2692 case R_SPARC_WDISP30:
2693 w1 = *pP & 0xC0000000;
2694 w2 = (Elf_Word)((value - P) >> 2);
2695 ASSERT((w2 & 0xC0000000) == 0);
2700 w1 = *pP & 0xFFC00000;
2701 w2 = (Elf_Word)(value >> 10);
2702 ASSERT((w2 & 0xFFC00000) == 0);
2708 w2 = (Elf_Word)(value & 0x3FF);
2709 ASSERT((w2 & ~0x3FF) == 0);
2713 /* According to the Sun documentation:
2715 This relocation type resembles R_SPARC_32, except it refers to an
2716 unaligned word. That is, the word to be relocated must be treated
2717 as four separate bytes with arbitrary alignment, not as a word
2718 aligned according to the architecture requirements.
2720 (JRS: which means that freeloading on the R_SPARC_32 case
2721 is probably wrong, but hey ...)
2725 w2 = (Elf_Word)value;
2728 # elif defined(ia64_TARGET_ARCH)
2729 case R_IA64_DIR64LSB:
2730 case R_IA64_FPTR64LSB:
2733 case R_IA64_SEGREL64LSB:
2734 addr = findElfSegment(ehdrC, value);
2737 case R_IA64_GPREL22:
2738 ia64_reloc_gprel22(P, value);
2740 case R_IA64_LTOFF22:
2741 case R_IA64_LTOFF_FPTR22:
2742 addr = allocateGOTEntry(value);
2743 ia64_reloc_gprel22(P, addr);
2745 case R_IA64_PCREL21B:
2746 ia64_reloc_pcrel21(P, S, oc);
2750 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2751 oc->fileName, ELF_R_TYPE(info));
2760 ocResolve_ELF ( ObjectCode* oc )
2764 Elf_Sym* stab = NULL;
2765 char* ehdrC = (char*)(oc->image);
2766 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2767 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2768 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2770 /* first find "the" symbol table */
2771 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2773 /* also go find the string table */
2774 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2776 if (stab == NULL || strtab == NULL) {
2777 belch("%s: can't find string or symbol table", oc->fileName);
2781 /* Process the relocation sections. */
2782 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2784 /* Skip sections called ".rel.stab". These appear to contain
2785 relocation entries that, when done, make the stabs debugging
2786 info point at the right places. We ain't interested in all
2788 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2791 if (shdr[shnum].sh_type == SHT_REL ) {
2792 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2793 shnum, stab, strtab );
2797 if (shdr[shnum].sh_type == SHT_RELA) {
2798 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2799 shnum, stab, strtab );
2804 /* Free the local symbol table; we won't need it again. */
2805 freeHashTable(oc->lochash, NULL);
2813 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2814 * at the front. The following utility functions pack and unpack instructions, and
2815 * take care of the most common relocations.
2818 #ifdef ia64_TARGET_ARCH
2821 ia64_extract_instruction(Elf64_Xword *target)
2824 int slot = (Elf_Addr)target & 3;
2825 (Elf_Addr)target &= ~3;
2833 return ((w1 >> 5) & 0x1ffffffffff);
2835 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2839 barf("ia64_extract_instruction: invalid slot %p", target);
2844 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2846 int slot = (Elf_Addr)target & 3;
2847 (Elf_Addr)target &= ~3;
2852 *target |= value << 5;
2855 *target |= value << 46;
2856 *(target+1) |= value >> 18;
2859 *(target+1) |= value << 23;
2865 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2867 Elf64_Xword instruction;
2868 Elf64_Sxword rel_value;
2870 rel_value = value - gp_val;
2871 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2872 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2874 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2875 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2876 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2877 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2878 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2879 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2883 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2885 Elf64_Xword instruction;
2886 Elf64_Sxword rel_value;
2889 entry = allocatePLTEntry(value, oc);
2891 rel_value = (entry >> 4) - (target >> 4);
2892 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2893 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2895 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2896 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2897 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2898 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2905 /* --------------------------------------------------------------------------
2907 * ------------------------------------------------------------------------*/
2909 #if defined(OBJFORMAT_MACHO)
2912 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2913 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2915 I hereby formally apologize for the hackish nature of this code.
2916 Things that need to be done:
2917 *) get common symbols and .bss sections to work properly.
2918 Haskell modules seem to work, but C modules can cause problems
2919 *) implement ocVerifyImage_MachO
2920 *) add more sanity checks. The current code just has to segfault if there's a
2924 static int ocVerifyImage_MachO(ObjectCode* oc)
2926 // FIXME: do some verifying here
2930 static void resolveImports(
2933 struct symtab_command *symLC,
2934 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2935 unsigned long *indirectSyms,
2936 struct nlist *nlist)
2940 for(i=0;i*4<sect->size;i++)
2942 // according to otool, reserved1 contains the first index into the indirect symbol table
2943 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2944 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2947 if((symbol->n_type & N_TYPE) == N_UNDF
2948 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
2949 addr = (void*) (symbol->n_value);
2950 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
2953 addr = lookupSymbol(nm);
2956 fprintf(stderr, "not found: %s\n", nm);
2960 ((void**)(image + sect->offset))[i] = addr;
2964 static void relocateSection(char *image,
2965 struct symtab_command *symLC, struct nlist *nlist,
2966 struct section* sections, struct section *sect)
2968 struct relocation_info *relocs;
2971 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
2973 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
2977 relocs = (struct relocation_info*) (image + sect->reloff);
2981 if(relocs[i].r_address & R_SCATTERED)
2983 struct scattered_relocation_info *scat =
2984 (struct scattered_relocation_info*) &relocs[i];
2988 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
2990 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
2992 *word = scat->r_value + sect->offset + ((long) image);
2996 continue; // FIXME: I hope it's OK to ignore all the others.
3000 struct relocation_info *reloc = &relocs[i];
3001 if(reloc->r_pcrel && !reloc->r_extern)
3004 if(!reloc->r_pcrel && reloc->r_length == 2)
3008 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3010 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3014 else if(reloc->r_type == PPC_RELOC_LO16)
3016 word = ((unsigned short*) wordPtr)[1];
3017 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3019 else if(reloc->r_type == PPC_RELOC_HI16)
3021 word = ((unsigned short*) wordPtr)[1] << 16;
3022 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3024 else if(reloc->r_type == PPC_RELOC_HA16)
3026 word = ((unsigned short*) wordPtr)[1] << 16;
3027 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3030 if(!reloc->r_extern)
3033 sections[reloc->r_symbolnum-1].offset
3034 - sections[reloc->r_symbolnum-1].addr
3041 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3042 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3043 word = (unsigned long) (lookupSymbol(nm));
3047 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3052 else if(reloc->r_type == PPC_RELOC_LO16)
3054 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3057 else if(reloc->r_type == PPC_RELOC_HI16)
3059 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3062 else if(reloc->r_type == PPC_RELOC_HA16)
3064 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3065 + ((word & (1<<15)) ? 1 : 0);
3070 fprintf(stderr, "unknown reloc\n");
3077 static int ocGetNames_MachO(ObjectCode* oc)
3079 char *image = (char*) oc->image;
3080 struct mach_header *header = (struct mach_header*) image;
3081 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3082 unsigned i,curSymbol;
3083 struct segment_command *segLC = NULL;
3084 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3085 struct symtab_command *symLC = NULL;
3086 struct dysymtab_command *dsymLC = NULL;
3087 struct nlist *nlist;
3088 unsigned long commonSize = 0;
3089 char *commonStorage = NULL;
3090 unsigned long commonCounter;
3092 for(i=0;i<header->ncmds;i++)
3094 if(lc->cmd == LC_SEGMENT)
3095 segLC = (struct segment_command*) lc;
3096 else if(lc->cmd == LC_SYMTAB)
3097 symLC = (struct symtab_command*) lc;
3098 else if(lc->cmd == LC_DYSYMTAB)
3099 dsymLC = (struct dysymtab_command*) lc;
3100 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3103 sections = (struct section*) (segLC+1);
3104 nlist = (struct nlist*) (image + symLC->symoff);
3106 for(i=0;i<segLC->nsects;i++)
3108 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3109 la_ptrs = §ions[i];
3110 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3111 nl_ptrs = §ions[i];
3113 // for now, only add __text and __const to the sections table
3114 else if(!strcmp(sections[i].sectname,"__text"))
3115 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3116 (void*) (image + sections[i].offset),
3117 (void*) (image + sections[i].offset + sections[i].size));
3118 else if(!strcmp(sections[i].sectname,"__const"))
3119 addSection(oc, SECTIONKIND_RWDATA,
3120 (void*) (image + sections[i].offset),
3121 (void*) (image + sections[i].offset + sections[i].size));
3122 else if(!strcmp(sections[i].sectname,"__data"))
3123 addSection(oc, SECTIONKIND_RWDATA,
3124 (void*) (image + sections[i].offset),
3125 (void*) (image + sections[i].offset + sections[i].size));
3128 // count external symbols defined here
3130 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3132 if((nlist[i].n_type & N_TYPE) == N_SECT)
3135 for(i=0;i<symLC->nsyms;i++)
3137 if((nlist[i].n_type & N_TYPE) == N_UNDF
3138 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3140 commonSize += nlist[i].n_value;
3144 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3145 "ocGetNames_MachO(oc->symbols)");
3147 // insert symbols into hash table
3148 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3150 if((nlist[i].n_type & N_TYPE) == N_SECT)
3152 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3153 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3154 sections[nlist[i].n_sect-1].offset
3155 - sections[nlist[i].n_sect-1].addr
3156 + nlist[i].n_value);
3157 oc->symbols[curSymbol++] = nm;
3161 // insert local symbols into lochash
3162 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3164 if((nlist[i].n_type & N_TYPE) == N_SECT)
3166 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3167 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3168 sections[nlist[i].n_sect-1].offset
3169 - sections[nlist[i].n_sect-1].addr
3170 + nlist[i].n_value);
3175 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3176 commonCounter = (unsigned long)commonStorage;
3177 for(i=0;i<symLC->nsyms;i++)
3179 if((nlist[i].n_type & N_TYPE) == N_UNDF
3180 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3182 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3183 unsigned long sz = nlist[i].n_value;
3185 nlist[i].n_value = commonCounter;
3187 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3188 oc->symbols[curSymbol++] = nm;
3190 commonCounter += sz;
3196 static int ocResolve_MachO(ObjectCode* oc)
3198 char *image = (char*) oc->image;
3199 struct mach_header *header = (struct mach_header*) image;
3200 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3202 struct segment_command *segLC = NULL;
3203 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3204 struct symtab_command *symLC = NULL;
3205 struct dysymtab_command *dsymLC = NULL;
3206 struct nlist *nlist;
3207 unsigned long *indirectSyms;
3209 for(i=0;i<header->ncmds;i++)
3211 if(lc->cmd == LC_SEGMENT)
3212 segLC = (struct segment_command*) lc;
3213 else if(lc->cmd == LC_SYMTAB)
3214 symLC = (struct symtab_command*) lc;
3215 else if(lc->cmd == LC_DYSYMTAB)
3216 dsymLC = (struct dysymtab_command*) lc;
3217 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3220 sections = (struct section*) (segLC+1);
3221 nlist = (struct nlist*) (image + symLC->symoff);
3223 for(i=0;i<segLC->nsects;i++)
3225 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3226 la_ptrs = §ions[i];
3227 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3228 nl_ptrs = §ions[i];
3231 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3234 resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist);
3236 resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist);
3238 for(i=0;i<segLC->nsects;i++)
3240 relocateSection(image,symLC,nlist,sections,§ions[i]);
3243 /* Free the local symbol table; we won't need it again. */
3244 freeHashTable(oc->lochash, NULL);