1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.109 2002/12/27 10:32:59 panne 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) \
396 SymX_redirect(newCAF, newDynCAF) \
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) /**/
556 #define SymX_redirect(vvv,xxx) /**/
560 RTS_POSIX_ONLY_SYMBOLS
561 RTS_MINGW_ONLY_SYMBOLS
562 RTS_CYGWIN_ONLY_SYMBOLS
567 #ifdef LEADING_UNDERSCORE
568 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
570 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
573 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
575 #define SymX(vvv) Sym(vvv)
577 // SymX_redirect allows us to redirect references to one symbol to
578 // another symbol. See newCAF/newDynCAF for an example.
579 #define SymX_redirect(vvv,xxx) \
580 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
583 static RtsSymbolVal rtsSyms[] = {
587 RTS_POSIX_ONLY_SYMBOLS
588 RTS_MINGW_ONLY_SYMBOLS
589 RTS_CYGWIN_ONLY_SYMBOLS
590 { 0, 0 } /* sentinel */
593 /* -----------------------------------------------------------------------------
594 * Insert symbols into hash tables, checking for duplicates.
596 static void ghciInsertStrHashTable ( char* obj_name,
602 if (lookupHashTable(table, (StgWord)key) == NULL)
604 insertStrHashTable(table, (StgWord)key, data);
609 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
611 "whilst processing object file\n"
613 "This could be caused by:\n"
614 " * Loading two different object files which export the same symbol\n"
615 " * Specifying the same object file twice on the GHCi command line\n"
616 " * An incorrect `package.conf' entry, causing some object to be\n"
618 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
627 /* -----------------------------------------------------------------------------
628 * initialize the object linker
632 static int linker_init_done = 0 ;
634 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
635 static void *dl_prog_handle;
643 /* Make initLinker idempotent, so we can call it
644 before evey relevant operation; that means we
645 don't need to initialise the linker separately */
646 if (linker_init_done == 1) { return; } else {
647 linker_init_done = 1;
650 symhash = allocStrHashTable();
652 /* populate the symbol table with stuff from the RTS */
653 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
654 ghciInsertStrHashTable("(GHCi built-in symbols)",
655 symhash, sym->lbl, sym->addr);
657 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
658 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
662 /* -----------------------------------------------------------------------------
663 * Loading DLL or .so dynamic libraries
664 * -----------------------------------------------------------------------------
666 * Add a DLL from which symbols may be found. In the ELF case, just
667 * do RTLD_GLOBAL-style add, so no further messing around needs to
668 * happen in order that symbols in the loaded .so are findable --
669 * lookupSymbol() will subsequently see them by dlsym on the program's
670 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
672 * In the PEi386 case, open the DLLs and put handles to them in a
673 * linked list. When looking for a symbol, try all handles in the
674 * list. This means that we need to load even DLLs that are guaranteed
675 * to be in the ghc.exe image already, just so we can get a handle
676 * to give to loadSymbol, so that we can find the symbols. For such
677 * libraries, the LoadLibrary call should be a no-op except for returning
682 #if defined(OBJFORMAT_PEi386)
683 /* A record for storing handles into DLLs. */
688 struct _OpenedDLL* next;
693 /* A list thereof. */
694 static OpenedDLL* opened_dlls = NULL;
698 addDLL( char *dll_name )
700 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
701 /* ------------------- ELF DLL loader ------------------- */
707 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
709 /* dlopen failed; return a ptr to the error msg. */
711 if (errmsg == NULL) errmsg = "addDLL: unknown error";
718 # elif defined(OBJFORMAT_PEi386)
719 /* ------------------- Win32 DLL loader ------------------- */
727 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
729 /* See if we've already got it, and ignore if so. */
730 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
731 if (0 == strcmp(o_dll->name, dll_name))
735 /* The file name has no suffix (yet) so that we can try
736 both foo.dll and foo.drv
738 The documentation for LoadLibrary says:
739 If no file name extension is specified in the lpFileName
740 parameter, the default library extension .dll is
741 appended. However, the file name string can include a trailing
742 point character (.) to indicate that the module name has no
745 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
746 sprintf(buf, "%s.DLL", dll_name);
747 instance = LoadLibrary(buf);
748 if (instance == NULL) {
749 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
750 instance = LoadLibrary(buf);
751 if (instance == NULL) {
754 /* LoadLibrary failed; return a ptr to the error msg. */
755 return "addDLL: unknown error";
760 /* Add this DLL to the list of DLLs in which to search for symbols. */
761 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
762 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
763 strcpy(o_dll->name, dll_name);
764 o_dll->instance = instance;
765 o_dll->next = opened_dlls;
770 barf("addDLL: not implemented on this platform");
774 /* -----------------------------------------------------------------------------
775 * lookup a symbol in the hash table
778 lookupSymbol( char *lbl )
782 ASSERT(symhash != NULL);
783 val = lookupStrHashTable(symhash, lbl);
786 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
787 return dlsym(dl_prog_handle, lbl);
788 # elif defined(OBJFORMAT_PEi386)
791 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
792 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
794 /* HACK: if the name has an initial underscore, try stripping
795 it off & look that up first. I've yet to verify whether there's
796 a Rule that governs whether an initial '_' *should always* be
797 stripped off when mapping from import lib name to the DLL name.
799 sym = GetProcAddress(o_dll->instance, (lbl+1));
801 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
805 sym = GetProcAddress(o_dll->instance, lbl);
807 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
822 __attribute((unused))
824 lookupLocalSymbol( ObjectCode* oc, char *lbl )
828 val = lookupStrHashTable(oc->lochash, lbl);
838 /* -----------------------------------------------------------------------------
839 * Debugging aid: look in GHCi's object symbol tables for symbols
840 * within DELTA bytes of the specified address, and show their names.
843 void ghci_enquire ( char* addr );
845 void ghci_enquire ( char* addr )
850 const int DELTA = 64;
855 for (oc = objects; oc; oc = oc->next) {
856 for (i = 0; i < oc->n_symbols; i++) {
857 sym = oc->symbols[i];
858 if (sym == NULL) continue;
859 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
861 if (oc->lochash != NULL) {
862 a = lookupStrHashTable(oc->lochash, sym);
865 a = lookupStrHashTable(symhash, sym);
868 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
870 else if (addr-DELTA <= a && a <= addr+DELTA) {
871 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
878 #ifdef ia64_TARGET_ARCH
879 static unsigned int PLTSize(void);
882 /* -----------------------------------------------------------------------------
883 * Load an obj (populate the global symbol table, but don't resolve yet)
885 * Returns: 1 if ok, 0 on error.
888 loadObj( char *path )
902 /* fprintf(stderr, "loadObj %s\n", path ); */
904 /* Check that we haven't already loaded this object. Don't give up
905 at this stage; ocGetNames_* will barf later. */
909 for (o = objects; o; o = o->next) {
910 if (0 == strcmp(o->fileName, path))
916 "GHCi runtime linker: warning: looks like you're trying to load the\n"
917 "same object file twice:\n"
919 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
925 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
927 # if defined(OBJFORMAT_ELF)
928 oc->formatName = "ELF";
929 # elif defined(OBJFORMAT_PEi386)
930 oc->formatName = "PEi386";
931 # elif defined(OBJFORMAT_MACHO)
932 oc->formatName = "Mach-O";
935 barf("loadObj: not implemented on this platform");
939 if (r == -1) { return 0; }
941 /* sigh, strdup() isn't a POSIX function, so do it the long way */
942 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
943 strcpy(oc->fileName, path);
945 oc->fileSize = st.st_size;
948 oc->lochash = allocStrHashTable();
949 oc->proddables = NULL;
951 /* chain it onto the list of objects */
956 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
958 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
960 fd = open(path, O_RDONLY);
962 barf("loadObj: can't open `%s'", path);
964 pagesize = getpagesize();
966 #ifdef ia64_TARGET_ARCH
967 /* The PLT needs to be right before the object */
968 n = ROUND_UP(PLTSize(), pagesize);
969 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
970 if (oc->plt == MAP_FAILED)
971 barf("loadObj: can't allocate PLT");
974 map_addr = oc->plt + n;
977 n = ROUND_UP(oc->fileSize, pagesize);
978 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
979 if (oc->image == MAP_FAILED)
980 barf("loadObj: can't map `%s'", path);
984 #else /* !USE_MMAP */
986 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
988 /* load the image into memory */
989 f = fopen(path, "rb");
991 barf("loadObj: can't read `%s'", path);
993 n = fread ( oc->image, 1, oc->fileSize, f );
994 if (n != oc->fileSize)
995 barf("loadObj: error whilst reading `%s'", path);
999 #endif /* USE_MMAP */
1001 /* verify the in-memory image */
1002 # if defined(OBJFORMAT_ELF)
1003 r = ocVerifyImage_ELF ( oc );
1004 # elif defined(OBJFORMAT_PEi386)
1005 r = ocVerifyImage_PEi386 ( oc );
1006 # elif defined(OBJFORMAT_MACHO)
1007 r = ocVerifyImage_MachO ( oc );
1009 barf("loadObj: no verify method");
1011 if (!r) { return r; }
1013 /* build the symbol list for this image */
1014 # if defined(OBJFORMAT_ELF)
1015 r = ocGetNames_ELF ( oc );
1016 # elif defined(OBJFORMAT_PEi386)
1017 r = ocGetNames_PEi386 ( oc );
1018 # elif defined(OBJFORMAT_MACHO)
1019 r = ocGetNames_MachO ( oc );
1021 barf("loadObj: no getNames method");
1023 if (!r) { return r; }
1025 /* loaded, but not resolved yet */
1026 oc->status = OBJECT_LOADED;
1031 /* -----------------------------------------------------------------------------
1032 * resolve all the currently unlinked objects in memory
1034 * Returns: 1 if ok, 0 on error.
1044 for (oc = objects; oc; oc = oc->next) {
1045 if (oc->status != OBJECT_RESOLVED) {
1046 # if defined(OBJFORMAT_ELF)
1047 r = ocResolve_ELF ( oc );
1048 # elif defined(OBJFORMAT_PEi386)
1049 r = ocResolve_PEi386 ( oc );
1050 # elif defined(OBJFORMAT_MACHO)
1051 r = ocResolve_MachO ( oc );
1053 barf("resolveObjs: not implemented on this platform");
1055 if (!r) { return r; }
1056 oc->status = OBJECT_RESOLVED;
1062 /* -----------------------------------------------------------------------------
1063 * delete an object from the pool
1066 unloadObj( char *path )
1068 ObjectCode *oc, *prev;
1070 ASSERT(symhash != NULL);
1071 ASSERT(objects != NULL);
1076 for (oc = objects; oc; prev = oc, oc = oc->next) {
1077 if (!strcmp(oc->fileName,path)) {
1079 /* Remove all the mappings for the symbols within this
1084 for (i = 0; i < oc->n_symbols; i++) {
1085 if (oc->symbols[i] != NULL) {
1086 removeStrHashTable(symhash, oc->symbols[i], NULL);
1094 prev->next = oc->next;
1097 /* We're going to leave this in place, in case there are
1098 any pointers from the heap into it: */
1099 /* free(oc->image); */
1103 /* The local hash table should have been freed at the end
1104 of the ocResolve_ call on it. */
1105 ASSERT(oc->lochash == NULL);
1111 belch("unloadObj: can't find `%s' to unload", path);
1115 /* -----------------------------------------------------------------------------
1116 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1117 * which may be prodded during relocation, and abort if we try and write
1118 * outside any of these.
1120 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1123 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1124 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1128 pb->next = oc->proddables;
1129 oc->proddables = pb;
1132 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1135 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1136 char* s = (char*)(pb->start);
1137 char* e = s + pb->size - 1;
1138 char* a = (char*)addr;
1139 /* Assumes that the biggest fixup involves a 4-byte write. This
1140 probably needs to be changed to 8 (ie, +7) on 64-bit
1142 if (a >= s && (a+3) <= e) return;
1144 barf("checkProddableBlock: invalid fixup in runtime linker");
1147 /* -----------------------------------------------------------------------------
1148 * Section management.
1150 static void addSection ( ObjectCode* oc, SectionKind kind,
1151 void* start, void* end )
1153 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1157 s->next = oc->sections;
1160 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1161 start, ((char*)end)-1, end - start + 1, kind );
1167 /* --------------------------------------------------------------------------
1168 * PEi386 specifics (Win32 targets)
1169 * ------------------------------------------------------------------------*/
1171 /* The information for this linker comes from
1172 Microsoft Portable Executable
1173 and Common Object File Format Specification
1174 revision 5.1 January 1998
1175 which SimonM says comes from the MS Developer Network CDs.
1177 It can be found there (on older CDs), but can also be found
1180 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1182 (this is Rev 6.0 from February 1999).
1184 Things move, so if that fails, try searching for it via
1186 http://www.google.com/search?q=PE+COFF+specification
1188 The ultimate reference for the PE format is the Winnt.h
1189 header file that comes with the Platform SDKs; as always,
1190 implementations will drift wrt their documentation.
1192 A good background article on the PE format is Matt Pietrek's
1193 March 1994 article in Microsoft System Journal (MSJ)
1194 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1195 Win32 Portable Executable File Format." The info in there
1196 has recently been updated in a two part article in
1197 MSDN magazine, issues Feb and March 2002,
1198 "Inside Windows: An In-Depth Look into the Win32 Portable
1199 Executable File Format"
1201 John Levine's book "Linkers and Loaders" contains useful
1206 #if defined(OBJFORMAT_PEi386)
1210 typedef unsigned char UChar;
1211 typedef unsigned short UInt16;
1212 typedef unsigned int UInt32;
1219 UInt16 NumberOfSections;
1220 UInt32 TimeDateStamp;
1221 UInt32 PointerToSymbolTable;
1222 UInt32 NumberOfSymbols;
1223 UInt16 SizeOfOptionalHeader;
1224 UInt16 Characteristics;
1228 #define sizeof_COFF_header 20
1235 UInt32 VirtualAddress;
1236 UInt32 SizeOfRawData;
1237 UInt32 PointerToRawData;
1238 UInt32 PointerToRelocations;
1239 UInt32 PointerToLinenumbers;
1240 UInt16 NumberOfRelocations;
1241 UInt16 NumberOfLineNumbers;
1242 UInt32 Characteristics;
1246 #define sizeof_COFF_section 40
1253 UInt16 SectionNumber;
1256 UChar NumberOfAuxSymbols;
1260 #define sizeof_COFF_symbol 18
1265 UInt32 VirtualAddress;
1266 UInt32 SymbolTableIndex;
1271 #define sizeof_COFF_reloc 10
1274 /* From PE spec doc, section 3.3.2 */
1275 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1276 windows.h -- for the same purpose, but I want to know what I'm
1278 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1279 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1280 #define MYIMAGE_FILE_DLL 0x2000
1281 #define MYIMAGE_FILE_SYSTEM 0x1000
1282 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1283 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1284 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1286 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1287 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1288 #define MYIMAGE_SYM_CLASS_STATIC 3
1289 #define MYIMAGE_SYM_UNDEFINED 0
1291 /* From PE spec doc, section 4.1 */
1292 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1293 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1294 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1296 /* From PE spec doc, section 5.2.1 */
1297 #define MYIMAGE_REL_I386_DIR32 0x0006
1298 #define MYIMAGE_REL_I386_REL32 0x0014
1301 /* We use myindex to calculate array addresses, rather than
1302 simply doing the normal subscript thing. That's because
1303 some of the above structs have sizes which are not
1304 a whole number of words. GCC rounds their sizes up to a
1305 whole number of words, which means that the address calcs
1306 arising from using normal C indexing or pointer arithmetic
1307 are just plain wrong. Sigh.
1310 myindex ( int scale, void* base, int index )
1313 ((UChar*)base) + scale * index;
1318 printName ( UChar* name, UChar* strtab )
1320 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1321 UInt32 strtab_offset = * (UInt32*)(name+4);
1322 fprintf ( stderr, "%s", strtab + strtab_offset );
1325 for (i = 0; i < 8; i++) {
1326 if (name[i] == 0) break;
1327 fprintf ( stderr, "%c", name[i] );
1334 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1336 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1337 UInt32 strtab_offset = * (UInt32*)(name+4);
1338 strncpy ( dst, strtab+strtab_offset, dstSize );
1344 if (name[i] == 0) break;
1354 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1357 /* If the string is longer than 8 bytes, look in the
1358 string table for it -- this will be correctly zero terminated.
1360 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1361 UInt32 strtab_offset = * (UInt32*)(name+4);
1362 return ((UChar*)strtab) + strtab_offset;
1364 /* Otherwise, if shorter than 8 bytes, return the original,
1365 which by defn is correctly terminated.
1367 if (name[7]==0) return name;
1368 /* The annoying case: 8 bytes. Copy into a temporary
1369 (which is never freed ...)
1371 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1373 strncpy(newstr,name,8);
1379 /* Just compares the short names (first 8 chars) */
1380 static COFF_section *
1381 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1385 = (COFF_header*)(oc->image);
1386 COFF_section* sectab
1388 ((UChar*)(oc->image))
1389 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1391 for (i = 0; i < hdr->NumberOfSections; i++) {
1394 COFF_section* section_i
1396 myindex ( sizeof_COFF_section, sectab, i );
1397 n1 = (UChar*) &(section_i->Name);
1399 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1400 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1401 n1[6]==n2[6] && n1[7]==n2[7])
1410 zapTrailingAtSign ( UChar* sym )
1412 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1414 if (sym[0] == 0) return;
1416 while (sym[i] != 0) i++;
1419 while (j > 0 && my_isdigit(sym[j])) j--;
1420 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1426 ocVerifyImage_PEi386 ( ObjectCode* oc )
1431 COFF_section* sectab;
1432 COFF_symbol* symtab;
1434 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1435 hdr = (COFF_header*)(oc->image);
1436 sectab = (COFF_section*) (
1437 ((UChar*)(oc->image))
1438 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1440 symtab = (COFF_symbol*) (
1441 ((UChar*)(oc->image))
1442 + hdr->PointerToSymbolTable
1444 strtab = ((UChar*)symtab)
1445 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1447 if (hdr->Machine != 0x14c) {
1448 belch("Not x86 PEi386");
1451 if (hdr->SizeOfOptionalHeader != 0) {
1452 belch("PEi386 with nonempty optional header");
1455 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1456 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1457 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1458 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1459 belch("Not a PEi386 object file");
1462 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1463 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1464 belch("Invalid PEi386 word size or endiannness: %d",
1465 (int)(hdr->Characteristics));
1468 /* If the string table size is way crazy, this might indicate that
1469 there are more than 64k relocations, despite claims to the
1470 contrary. Hence this test. */
1471 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1473 if ( (*(UInt32*)strtab) > 600000 ) {
1474 /* Note that 600k has no special significance other than being
1475 big enough to handle the almost-2MB-sized lumps that
1476 constitute HSwin32*.o. */
1477 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1482 /* No further verification after this point; only debug printing. */
1484 IF_DEBUG(linker, i=1);
1485 if (i == 0) return 1;
1488 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1490 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1492 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1494 fprintf ( stderr, "\n" );
1496 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1498 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1500 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1502 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1504 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1506 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1508 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1510 /* Print the section table. */
1511 fprintf ( stderr, "\n" );
1512 for (i = 0; i < hdr->NumberOfSections; i++) {
1514 COFF_section* sectab_i
1516 myindex ( sizeof_COFF_section, sectab, i );
1523 printName ( sectab_i->Name, strtab );
1533 sectab_i->VirtualSize,
1534 sectab_i->VirtualAddress,
1535 sectab_i->SizeOfRawData,
1536 sectab_i->PointerToRawData,
1537 sectab_i->NumberOfRelocations,
1538 sectab_i->PointerToRelocations,
1539 sectab_i->PointerToRawData
1541 reltab = (COFF_reloc*) (
1542 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1545 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1546 /* If the relocation field (a short) has overflowed, the
1547 * real count can be found in the first reloc entry.
1549 * See Section 4.1 (last para) of the PE spec (rev6.0).
1551 COFF_reloc* rel = (COFF_reloc*)
1552 myindex ( sizeof_COFF_reloc, reltab, 0 );
1553 noRelocs = rel->VirtualAddress;
1556 noRelocs = sectab_i->NumberOfRelocations;
1560 for (; j < noRelocs; j++) {
1562 COFF_reloc* rel = (COFF_reloc*)
1563 myindex ( sizeof_COFF_reloc, reltab, j );
1565 " type 0x%-4x vaddr 0x%-8x name `",
1567 rel->VirtualAddress );
1568 sym = (COFF_symbol*)
1569 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1570 /* Hmm..mysterious looking offset - what's it for? SOF */
1571 printName ( sym->Name, strtab -10 );
1572 fprintf ( stderr, "'\n" );
1575 fprintf ( stderr, "\n" );
1577 fprintf ( stderr, "\n" );
1578 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1579 fprintf ( stderr, "---START of string table---\n");
1580 for (i = 4; i < *(Int32*)strtab; i++) {
1582 fprintf ( stderr, "\n"); else
1583 fprintf( stderr, "%c", strtab[i] );
1585 fprintf ( stderr, "--- END of string table---\n");
1587 fprintf ( stderr, "\n" );
1590 COFF_symbol* symtab_i;
1591 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1592 symtab_i = (COFF_symbol*)
1593 myindex ( sizeof_COFF_symbol, symtab, i );
1599 printName ( symtab_i->Name, strtab );
1608 (Int32)(symtab_i->SectionNumber),
1609 (UInt32)symtab_i->Type,
1610 (UInt32)symtab_i->StorageClass,
1611 (UInt32)symtab_i->NumberOfAuxSymbols
1613 i += symtab_i->NumberOfAuxSymbols;
1617 fprintf ( stderr, "\n" );
1623 ocGetNames_PEi386 ( ObjectCode* oc )
1626 COFF_section* sectab;
1627 COFF_symbol* symtab;
1634 hdr = (COFF_header*)(oc->image);
1635 sectab = (COFF_section*) (
1636 ((UChar*)(oc->image))
1637 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1639 symtab = (COFF_symbol*) (
1640 ((UChar*)(oc->image))
1641 + hdr->PointerToSymbolTable
1643 strtab = ((UChar*)(oc->image))
1644 + hdr->PointerToSymbolTable
1645 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1647 /* Allocate space for any (local, anonymous) .bss sections. */
1649 for (i = 0; i < hdr->NumberOfSections; i++) {
1651 COFF_section* sectab_i
1653 myindex ( sizeof_COFF_section, sectab, i );
1654 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1655 if (sectab_i->VirtualSize == 0) continue;
1656 /* This is a non-empty .bss section. Allocate zeroed space for
1657 it, and set its PointerToRawData field such that oc->image +
1658 PointerToRawData == addr_of_zeroed_space. */
1659 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1660 "ocGetNames_PEi386(anonymous bss)");
1661 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1662 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1663 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1666 /* Copy section information into the ObjectCode. */
1668 for (i = 0; i < hdr->NumberOfSections; i++) {
1674 = SECTIONKIND_OTHER;
1675 COFF_section* sectab_i
1677 myindex ( sizeof_COFF_section, sectab, i );
1678 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1681 /* I'm sure this is the Right Way to do it. However, the
1682 alternative of testing the sectab_i->Name field seems to
1683 work ok with Cygwin.
1685 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1686 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1687 kind = SECTIONKIND_CODE_OR_RODATA;
1690 if (0==strcmp(".text",sectab_i->Name) ||
1691 0==strcmp(".rodata",sectab_i->Name))
1692 kind = SECTIONKIND_CODE_OR_RODATA;
1693 if (0==strcmp(".data",sectab_i->Name) ||
1694 0==strcmp(".bss",sectab_i->Name))
1695 kind = SECTIONKIND_RWDATA;
1697 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1698 sz = sectab_i->SizeOfRawData;
1699 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1701 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1702 end = start + sz - 1;
1704 if (kind == SECTIONKIND_OTHER
1705 /* Ignore sections called which contain stabs debugging
1707 && 0 != strcmp(".stab", sectab_i->Name)
1708 && 0 != strcmp(".stabstr", sectab_i->Name)
1710 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1714 if (kind != SECTIONKIND_OTHER && end >= start) {
1715 addSection(oc, kind, start, end);
1716 addProddableBlock(oc, start, end - start + 1);
1720 /* Copy exported symbols into the ObjectCode. */
1722 oc->n_symbols = hdr->NumberOfSymbols;
1723 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1724 "ocGetNames_PEi386(oc->symbols)");
1725 /* Call me paranoid; I don't care. */
1726 for (i = 0; i < oc->n_symbols; i++)
1727 oc->symbols[i] = NULL;
1731 COFF_symbol* symtab_i;
1732 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1733 symtab_i = (COFF_symbol*)
1734 myindex ( sizeof_COFF_symbol, symtab, i );
1738 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1739 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1740 /* This symbol is global and defined, viz, exported */
1741 /* for MYIMAGE_SYMCLASS_EXTERNAL
1742 && !MYIMAGE_SYM_UNDEFINED,
1743 the address of the symbol is:
1744 address of relevant section + offset in section
1746 COFF_section* sectabent
1747 = (COFF_section*) myindex ( sizeof_COFF_section,
1749 symtab_i->SectionNumber-1 );
1750 addr = ((UChar*)(oc->image))
1751 + (sectabent->PointerToRawData
1755 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1756 && symtab_i->Value > 0) {
1757 /* This symbol isn't in any section at all, ie, global bss.
1758 Allocate zeroed space for it. */
1759 addr = stgCallocBytes(1, symtab_i->Value,
1760 "ocGetNames_PEi386(non-anonymous bss)");
1761 addSection(oc, SECTIONKIND_RWDATA, addr,
1762 ((UChar*)addr) + symtab_i->Value - 1);
1763 addProddableBlock(oc, addr, symtab_i->Value);
1764 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1767 if (addr != NULL ) {
1768 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1769 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1770 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1771 ASSERT(i >= 0 && i < oc->n_symbols);
1772 /* cstring_from_COFF_symbol_name always succeeds. */
1773 oc->symbols[i] = sname;
1774 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1778 "IGNORING symbol %d\n"
1782 printName ( symtab_i->Name, strtab );
1791 (Int32)(symtab_i->SectionNumber),
1792 (UInt32)symtab_i->Type,
1793 (UInt32)symtab_i->StorageClass,
1794 (UInt32)symtab_i->NumberOfAuxSymbols
1799 i += symtab_i->NumberOfAuxSymbols;
1808 ocResolve_PEi386 ( ObjectCode* oc )
1811 COFF_section* sectab;
1812 COFF_symbol* symtab;
1822 /* ToDo: should be variable-sized? But is at least safe in the
1823 sense of buffer-overrun-proof. */
1825 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1827 hdr = (COFF_header*)(oc->image);
1828 sectab = (COFF_section*) (
1829 ((UChar*)(oc->image))
1830 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1832 symtab = (COFF_symbol*) (
1833 ((UChar*)(oc->image))
1834 + hdr->PointerToSymbolTable
1836 strtab = ((UChar*)(oc->image))
1837 + hdr->PointerToSymbolTable
1838 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1840 for (i = 0; i < hdr->NumberOfSections; i++) {
1841 COFF_section* sectab_i
1843 myindex ( sizeof_COFF_section, sectab, i );
1846 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1849 /* Ignore sections called which contain stabs debugging
1851 if (0 == strcmp(".stab", sectab_i->Name)
1852 || 0 == strcmp(".stabstr", sectab_i->Name))
1855 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1856 /* If the relocation field (a short) has overflowed, the
1857 * real count can be found in the first reloc entry.
1859 * See Section 4.1 (last para) of the PE spec (rev6.0).
1861 COFF_reloc* rel = (COFF_reloc*)
1862 myindex ( sizeof_COFF_reloc, reltab, 0 );
1863 noRelocs = rel->VirtualAddress;
1864 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1867 noRelocs = sectab_i->NumberOfRelocations;
1872 for (; j < noRelocs; j++) {
1874 COFF_reloc* reltab_j
1876 myindex ( sizeof_COFF_reloc, reltab, j );
1878 /* the location to patch */
1880 ((UChar*)(oc->image))
1881 + (sectab_i->PointerToRawData
1882 + reltab_j->VirtualAddress
1883 - sectab_i->VirtualAddress )
1885 /* the existing contents of pP */
1887 /* the symbol to connect to */
1888 sym = (COFF_symbol*)
1889 myindex ( sizeof_COFF_symbol,
1890 symtab, reltab_j->SymbolTableIndex );
1893 "reloc sec %2d num %3d: type 0x%-4x "
1894 "vaddr 0x%-8x name `",
1896 (UInt32)reltab_j->Type,
1897 reltab_j->VirtualAddress );
1898 printName ( sym->Name, strtab );
1899 fprintf ( stderr, "'\n" ));
1901 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1902 COFF_section* section_sym
1903 = findPEi386SectionCalled ( oc, sym->Name );
1905 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1908 S = ((UInt32)(oc->image))
1909 + (section_sym->PointerToRawData
1912 copyName ( sym->Name, strtab, symbol, 1000-1 );
1913 (void*)S = lookupLocalSymbol( oc, symbol );
1914 if ((void*)S != NULL) goto foundit;
1915 (void*)S = lookupSymbol( symbol );
1916 if ((void*)S != NULL) goto foundit;
1917 zapTrailingAtSign ( symbol );
1918 (void*)S = lookupLocalSymbol( oc, symbol );
1919 if ((void*)S != NULL) goto foundit;
1920 (void*)S = lookupSymbol( symbol );
1921 if ((void*)S != NULL) goto foundit;
1922 /* Newline first because the interactive linker has printed "linking..." */
1923 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1927 checkProddableBlock(oc, pP);
1928 switch (reltab_j->Type) {
1929 case MYIMAGE_REL_I386_DIR32:
1932 case MYIMAGE_REL_I386_REL32:
1933 /* Tricky. We have to insert a displacement at
1934 pP which, when added to the PC for the _next_
1935 insn, gives the address of the target (S).
1936 Problem is to know the address of the next insn
1937 when we only know pP. We assume that this
1938 literal field is always the last in the insn,
1939 so that the address of the next insn is pP+4
1940 -- hence the constant 4.
1941 Also I don't know if A should be added, but so
1942 far it has always been zero.
1945 *pP = S - ((UInt32)pP) - 4;
1948 belch("%s: unhandled PEi386 relocation type %d",
1949 oc->fileName, reltab_j->Type);
1956 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1960 #endif /* defined(OBJFORMAT_PEi386) */
1963 /* --------------------------------------------------------------------------
1965 * ------------------------------------------------------------------------*/
1967 #if defined(OBJFORMAT_ELF)
1972 #if defined(sparc_TARGET_ARCH)
1973 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1974 #elif defined(i386_TARGET_ARCH)
1975 # define ELF_TARGET_386 /* Used inside <elf.h> */
1976 #elif defined (ia64_TARGET_ARCH)
1977 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
1979 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
1980 # define ELF_NEED_GOT /* needs Global Offset Table */
1981 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
1987 * Define a set of types which can be used for both ELF32 and ELF64
1991 #define ELFCLASS ELFCLASS64
1992 #define Elf_Addr Elf64_Addr
1993 #define Elf_Word Elf64_Word
1994 #define Elf_Sword Elf64_Sword
1995 #define Elf_Ehdr Elf64_Ehdr
1996 #define Elf_Phdr Elf64_Phdr
1997 #define Elf_Shdr Elf64_Shdr
1998 #define Elf_Sym Elf64_Sym
1999 #define Elf_Rel Elf64_Rel
2000 #define Elf_Rela Elf64_Rela
2001 #define ELF_ST_TYPE ELF64_ST_TYPE
2002 #define ELF_ST_BIND ELF64_ST_BIND
2003 #define ELF_R_TYPE ELF64_R_TYPE
2004 #define ELF_R_SYM ELF64_R_SYM
2006 #define ELFCLASS ELFCLASS32
2007 #define Elf_Addr Elf32_Addr
2008 #define Elf_Word Elf32_Word
2009 #define Elf_Sword Elf32_Sword
2010 #define Elf_Ehdr Elf32_Ehdr
2011 #define Elf_Phdr Elf32_Phdr
2012 #define Elf_Shdr Elf32_Shdr
2013 #define Elf_Sym Elf32_Sym
2014 #define Elf_Rel Elf32_Rel
2015 #define Elf_Rela Elf32_Rela
2016 #define ELF_ST_TYPE ELF32_ST_TYPE
2017 #define ELF_ST_BIND ELF32_ST_BIND
2018 #define ELF_R_TYPE ELF32_R_TYPE
2019 #define ELF_R_SYM ELF32_R_SYM
2024 * Functions to allocate entries in dynamic sections. Currently we simply
2025 * preallocate a large number, and we don't check if a entry for the given
2026 * target already exists (a linear search is too slow). Ideally these
2027 * entries would be associated with symbols.
2030 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2031 #define GOT_SIZE 0x20000
2032 #define FUNCTION_TABLE_SIZE 0x10000
2033 #define PLT_SIZE 0x08000
2036 static Elf_Addr got[GOT_SIZE];
2037 static unsigned int gotIndex;
2038 static Elf_Addr gp_val = (Elf_Addr)got;
2041 allocateGOTEntry(Elf_Addr target)
2045 if (gotIndex >= GOT_SIZE)
2046 barf("Global offset table overflow");
2048 entry = &got[gotIndex++];
2050 return (Elf_Addr)entry;
2054 #ifdef ELF_FUNCTION_DESC
2060 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2061 static unsigned int functionTableIndex;
2064 allocateFunctionDesc(Elf_Addr target)
2066 FunctionDesc *entry;
2068 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2069 barf("Function table overflow");
2071 entry = &functionTable[functionTableIndex++];
2073 entry->gp = (Elf_Addr)gp_val;
2074 return (Elf_Addr)entry;
2078 copyFunctionDesc(Elf_Addr target)
2080 FunctionDesc *olddesc = (FunctionDesc *)target;
2081 FunctionDesc *newdesc;
2083 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2084 newdesc->gp = olddesc->gp;
2085 return (Elf_Addr)newdesc;
2090 #ifdef ia64_TARGET_ARCH
2091 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2092 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2094 static unsigned char plt_code[] =
2096 /* taken from binutils bfd/elfxx-ia64.c */
2097 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2098 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2099 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2100 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2101 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2102 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2105 /* If we can't get to the function descriptor via gp, take a local copy of it */
2106 #define PLT_RELOC(code, target) { \
2107 Elf64_Sxword rel_value = target - gp_val; \
2108 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2109 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2111 ia64_reloc_gprel22((Elf_Addr)code, target); \
2116 unsigned char code[sizeof(plt_code)];
2120 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2122 PLTEntry *plt = (PLTEntry *)oc->plt;
2125 if (oc->pltIndex >= PLT_SIZE)
2126 barf("Procedure table overflow");
2128 entry = &plt[oc->pltIndex++];
2129 memcpy(entry->code, plt_code, sizeof(entry->code));
2130 PLT_RELOC(entry->code, target);
2131 return (Elf_Addr)entry;
2137 return (PLT_SIZE * sizeof(PLTEntry));
2143 * Generic ELF functions
2147 findElfSection ( void* objImage, Elf_Word sh_type )
2149 char* ehdrC = (char*)objImage;
2150 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2151 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2152 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2156 for (i = 0; i < ehdr->e_shnum; i++) {
2157 if (shdr[i].sh_type == sh_type
2158 /* Ignore the section header's string table. */
2159 && i != ehdr->e_shstrndx
2160 /* Ignore string tables named .stabstr, as they contain
2162 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2164 ptr = ehdrC + shdr[i].sh_offset;
2171 #if defined(ia64_TARGET_ARCH)
2173 findElfSegment ( void* objImage, Elf_Addr vaddr )
2175 char* ehdrC = (char*)objImage;
2176 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2177 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2178 Elf_Addr segaddr = 0;
2181 for (i = 0; i < ehdr->e_phnum; i++) {
2182 segaddr = phdr[i].p_vaddr;
2183 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2191 ocVerifyImage_ELF ( ObjectCode* oc )
2195 int i, j, nent, nstrtab, nsymtabs;
2199 char* ehdrC = (char*)(oc->image);
2200 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2202 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2203 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2204 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2205 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2206 belch("%s: not an ELF object", oc->fileName);
2210 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2211 belch("%s: unsupported ELF format", oc->fileName);
2215 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2216 IF_DEBUG(linker,belch( "Is little-endian" ));
2218 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2219 IF_DEBUG(linker,belch( "Is big-endian" ));
2221 belch("%s: unknown endiannness", oc->fileName);
2225 if (ehdr->e_type != ET_REL) {
2226 belch("%s: not a relocatable object (.o) file", oc->fileName);
2229 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2231 IF_DEBUG(linker,belch( "Architecture is " ));
2232 switch (ehdr->e_machine) {
2233 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2234 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2236 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2238 default: IF_DEBUG(linker,belch( "unknown" ));
2239 belch("%s: unknown architecture", oc->fileName);
2243 IF_DEBUG(linker,belch(
2244 "\nSection header table: start %d, n_entries %d, ent_size %d",
2245 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2247 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2249 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2251 if (ehdr->e_shstrndx == SHN_UNDEF) {
2252 belch("%s: no section header string table", oc->fileName);
2255 IF_DEBUG(linker,belch( "Section header string table is section %d",
2257 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2260 for (i = 0; i < ehdr->e_shnum; i++) {
2261 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2262 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2263 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2264 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2265 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2266 ehdrC + shdr[i].sh_offset,
2267 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2269 if (shdr[i].sh_type == SHT_REL) {
2270 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2271 } else if (shdr[i].sh_type == SHT_RELA) {
2272 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2274 IF_DEBUG(linker,fprintf(stderr," "));
2277 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2281 IF_DEBUG(linker,belch( "\nString tables" ));
2284 for (i = 0; i < ehdr->e_shnum; i++) {
2285 if (shdr[i].sh_type == SHT_STRTAB
2286 /* Ignore the section header's string table. */
2287 && i != ehdr->e_shstrndx
2288 /* Ignore string tables named .stabstr, as they contain
2290 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2292 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2293 strtab = ehdrC + shdr[i].sh_offset;
2298 belch("%s: no string tables, or too many", oc->fileName);
2303 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2304 for (i = 0; i < ehdr->e_shnum; i++) {
2305 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2306 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2308 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2309 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2310 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2312 shdr[i].sh_size % sizeof(Elf_Sym)
2314 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2315 belch("%s: non-integral number of symbol table entries", oc->fileName);
2318 for (j = 0; j < nent; j++) {
2319 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2320 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2321 (int)stab[j].st_shndx,
2322 (int)stab[j].st_size,
2323 (char*)stab[j].st_value ));
2325 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2326 switch (ELF_ST_TYPE(stab[j].st_info)) {
2327 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2328 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2329 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2330 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2331 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2332 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2334 IF_DEBUG(linker,fprintf(stderr, " " ));
2336 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2337 switch (ELF_ST_BIND(stab[j].st_info)) {
2338 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2339 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2340 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2341 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2343 IF_DEBUG(linker,fprintf(stderr, " " ));
2345 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2349 if (nsymtabs == 0) {
2350 belch("%s: didn't find any symbol tables", oc->fileName);
2359 ocGetNames_ELF ( ObjectCode* oc )
2364 char* ehdrC = (char*)(oc->image);
2365 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2366 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2367 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2369 ASSERT(symhash != NULL);
2372 belch("%s: no strtab", oc->fileName);
2377 for (i = 0; i < ehdr->e_shnum; i++) {
2378 /* Figure out what kind of section it is. Logic derived from
2379 Figure 1.14 ("Special Sections") of the ELF document
2380 ("Portable Formats Specification, Version 1.1"). */
2381 Elf_Shdr hdr = shdr[i];
2382 SectionKind kind = SECTIONKIND_OTHER;
2385 if (hdr.sh_type == SHT_PROGBITS
2386 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2387 /* .text-style section */
2388 kind = SECTIONKIND_CODE_OR_RODATA;
2391 if (hdr.sh_type == SHT_PROGBITS
2392 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2393 /* .data-style section */
2394 kind = SECTIONKIND_RWDATA;
2397 if (hdr.sh_type == SHT_PROGBITS
2398 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2399 /* .rodata-style section */
2400 kind = SECTIONKIND_CODE_OR_RODATA;
2403 if (hdr.sh_type == SHT_NOBITS
2404 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2405 /* .bss-style section */
2406 kind = SECTIONKIND_RWDATA;
2410 if (is_bss && shdr[i].sh_size > 0) {
2411 /* This is a non-empty .bss section. Allocate zeroed space for
2412 it, and set its .sh_offset field such that
2413 ehdrC + .sh_offset == addr_of_zeroed_space. */
2414 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2415 "ocGetNames_ELF(BSS)");
2416 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2418 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2419 zspace, shdr[i].sh_size);
2423 /* fill in the section info */
2424 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2425 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2426 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2427 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2430 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2432 /* copy stuff into this module's object symbol table */
2433 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2434 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2436 oc->n_symbols = nent;
2437 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2438 "ocGetNames_ELF(oc->symbols)");
2440 for (j = 0; j < nent; j++) {
2442 char isLocal = FALSE; /* avoids uninit-var warning */
2444 char* nm = strtab + stab[j].st_name;
2445 int secno = stab[j].st_shndx;
2447 /* Figure out if we want to add it; if so, set ad to its
2448 address. Otherwise leave ad == NULL. */
2450 if (secno == SHN_COMMON) {
2452 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2454 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2455 stab[j].st_size, nm);
2457 /* Pointless to do addProddableBlock() for this area,
2458 since the linker should never poke around in it. */
2461 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2462 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2464 /* and not an undefined symbol */
2465 && stab[j].st_shndx != SHN_UNDEF
2466 /* and not in a "special section" */
2467 && stab[j].st_shndx < SHN_LORESERVE
2469 /* and it's a not a section or string table or anything silly */
2470 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2471 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2472 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2475 /* Section 0 is the undefined section, hence > and not >=. */
2476 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2478 if (shdr[secno].sh_type == SHT_NOBITS) {
2479 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2480 stab[j].st_size, stab[j].st_value, nm);
2483 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2484 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2487 #ifdef ELF_FUNCTION_DESC
2488 /* dlsym() and the initialisation table both give us function
2489 * descriptors, so to be consistent we store function descriptors
2490 * in the symbol table */
2491 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2492 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2494 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2495 ad, oc->fileName, nm ));
2500 /* And the decision is ... */
2504 oc->symbols[j] = nm;
2507 /* Ignore entirely. */
2509 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2513 IF_DEBUG(linker,belch( "skipping `%s'",
2514 strtab + stab[j].st_name ));
2517 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2518 (int)ELF_ST_BIND(stab[j].st_info),
2519 (int)ELF_ST_TYPE(stab[j].st_info),
2520 (int)stab[j].st_shndx,
2521 strtab + stab[j].st_name
2524 oc->symbols[j] = NULL;
2533 /* Do ELF relocations which lack an explicit addend. All x86-linux
2534 relocations appear to be of this form. */
2536 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2537 Elf_Shdr* shdr, int shnum,
2538 Elf_Sym* stab, char* strtab )
2543 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2544 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2545 int target_shndx = shdr[shnum].sh_info;
2546 int symtab_shndx = shdr[shnum].sh_link;
2548 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2549 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2550 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2551 target_shndx, symtab_shndx ));
2553 for (j = 0; j < nent; j++) {
2554 Elf_Addr offset = rtab[j].r_offset;
2555 Elf_Addr info = rtab[j].r_info;
2557 Elf_Addr P = ((Elf_Addr)targ) + offset;
2558 Elf_Word* pP = (Elf_Word*)P;
2563 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2564 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);
2580 /* No, so look up the name in our global table. */
2581 symbol = strtab + sym.st_name;
2582 (void*)S = lookupSymbol( symbol );
2585 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2588 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2591 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2592 (void*)P, (void*)S, (void*)A ));
2593 checkProddableBlock ( oc, pP );
2597 switch (ELF_R_TYPE(info)) {
2598 # ifdef i386_TARGET_ARCH
2599 case R_386_32: *pP = value; break;
2600 case R_386_PC32: *pP = value - P; break;
2603 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2604 oc->fileName, ELF_R_TYPE(info));
2612 /* Do ELF relocations for which explicit addends are supplied.
2613 sparc-solaris relocations appear to be of this form. */
2615 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2616 Elf_Shdr* shdr, int shnum,
2617 Elf_Sym* stab, char* strtab )
2622 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2623 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2624 int target_shndx = shdr[shnum].sh_info;
2625 int symtab_shndx = shdr[shnum].sh_link;
2627 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2628 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2629 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2630 target_shndx, symtab_shndx ));
2632 for (j = 0; j < nent; j++) {
2633 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2634 /* This #ifdef only serves to avoid unused-var warnings. */
2635 Elf_Addr offset = rtab[j].r_offset;
2636 Elf_Addr P = targ + offset;
2638 Elf_Addr info = rtab[j].r_info;
2639 Elf_Addr A = rtab[j].r_addend;
2642 # if defined(sparc_TARGET_ARCH)
2643 Elf_Word* pP = (Elf_Word*)P;
2645 # elif defined(ia64_TARGET_ARCH)
2646 Elf64_Xword *pP = (Elf64_Xword *)P;
2650 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2651 j, (void*)offset, (void*)info,
2654 IF_DEBUG(linker,belch( " ZERO" ));
2657 Elf_Sym sym = stab[ELF_R_SYM(info)];
2658 /* First see if it is a local symbol. */
2659 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2660 /* Yes, so we can get the address directly from the ELF symbol
2662 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2664 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2665 + stab[ELF_R_SYM(info)].st_value);
2666 #ifdef ELF_FUNCTION_DESC
2667 /* Make a function descriptor for this function */
2668 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2669 S = allocateFunctionDesc(S + A);
2674 /* No, so look up the name in our global table. */
2675 symbol = strtab + sym.st_name;
2676 (void*)S = lookupSymbol( symbol );
2678 #ifdef ELF_FUNCTION_DESC
2679 /* If a function, already a function descriptor - we would
2680 have to copy it to add an offset. */
2681 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2686 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2689 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2692 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2693 (void*)P, (void*)S, (void*)A ));
2694 /* checkProddableBlock ( oc, (void*)P ); */
2698 switch (ELF_R_TYPE(info)) {
2699 # if defined(sparc_TARGET_ARCH)
2700 case R_SPARC_WDISP30:
2701 w1 = *pP & 0xC0000000;
2702 w2 = (Elf_Word)((value - P) >> 2);
2703 ASSERT((w2 & 0xC0000000) == 0);
2708 w1 = *pP & 0xFFC00000;
2709 w2 = (Elf_Word)(value >> 10);
2710 ASSERT((w2 & 0xFFC00000) == 0);
2716 w2 = (Elf_Word)(value & 0x3FF);
2717 ASSERT((w2 & ~0x3FF) == 0);
2721 /* According to the Sun documentation:
2723 This relocation type resembles R_SPARC_32, except it refers to an
2724 unaligned word. That is, the word to be relocated must be treated
2725 as four separate bytes with arbitrary alignment, not as a word
2726 aligned according to the architecture requirements.
2728 (JRS: which means that freeloading on the R_SPARC_32 case
2729 is probably wrong, but hey ...)
2733 w2 = (Elf_Word)value;
2736 # elif defined(ia64_TARGET_ARCH)
2737 case R_IA64_DIR64LSB:
2738 case R_IA64_FPTR64LSB:
2741 case R_IA64_SEGREL64LSB:
2742 addr = findElfSegment(ehdrC, value);
2745 case R_IA64_GPREL22:
2746 ia64_reloc_gprel22(P, value);
2748 case R_IA64_LTOFF22:
2749 case R_IA64_LTOFF_FPTR22:
2750 addr = allocateGOTEntry(value);
2751 ia64_reloc_gprel22(P, addr);
2753 case R_IA64_PCREL21B:
2754 ia64_reloc_pcrel21(P, S, oc);
2758 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2759 oc->fileName, ELF_R_TYPE(info));
2768 ocResolve_ELF ( ObjectCode* oc )
2772 Elf_Sym* stab = NULL;
2773 char* ehdrC = (char*)(oc->image);
2774 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2775 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2776 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2778 /* first find "the" symbol table */
2779 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2781 /* also go find the string table */
2782 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2784 if (stab == NULL || strtab == NULL) {
2785 belch("%s: can't find string or symbol table", oc->fileName);
2789 /* Process the relocation sections. */
2790 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2792 /* Skip sections called ".rel.stab". These appear to contain
2793 relocation entries that, when done, make the stabs debugging
2794 info point at the right places. We ain't interested in all
2796 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2799 if (shdr[shnum].sh_type == SHT_REL ) {
2800 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2801 shnum, stab, strtab );
2805 if (shdr[shnum].sh_type == SHT_RELA) {
2806 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2807 shnum, stab, strtab );
2812 /* Free the local symbol table; we won't need it again. */
2813 freeHashTable(oc->lochash, NULL);
2821 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2822 * at the front. The following utility functions pack and unpack instructions, and
2823 * take care of the most common relocations.
2826 #ifdef ia64_TARGET_ARCH
2829 ia64_extract_instruction(Elf64_Xword *target)
2832 int slot = (Elf_Addr)target & 3;
2833 (Elf_Addr)target &= ~3;
2841 return ((w1 >> 5) & 0x1ffffffffff);
2843 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2847 barf("ia64_extract_instruction: invalid slot %p", target);
2852 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2854 int slot = (Elf_Addr)target & 3;
2855 (Elf_Addr)target &= ~3;
2860 *target |= value << 5;
2863 *target |= value << 46;
2864 *(target+1) |= value >> 18;
2867 *(target+1) |= value << 23;
2873 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2875 Elf64_Xword instruction;
2876 Elf64_Sxword rel_value;
2878 rel_value = value - gp_val;
2879 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2880 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2882 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2883 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2884 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2885 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2886 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2887 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2891 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2893 Elf64_Xword instruction;
2894 Elf64_Sxword rel_value;
2897 entry = allocatePLTEntry(value, oc);
2899 rel_value = (entry >> 4) - (target >> 4);
2900 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2901 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2903 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2904 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2905 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2906 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2913 /* --------------------------------------------------------------------------
2915 * ------------------------------------------------------------------------*/
2917 #if defined(OBJFORMAT_MACHO)
2920 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2921 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2923 I hereby formally apologize for the hackish nature of this code.
2924 Things that need to be done:
2925 *) get common symbols and .bss sections to work properly.
2926 Haskell modules seem to work, but C modules can cause problems
2927 *) implement ocVerifyImage_MachO
2928 *) add more sanity checks. The current code just has to segfault if there's a
2932 static int ocVerifyImage_MachO(ObjectCode* oc)
2934 // FIXME: do some verifying here
2938 static void resolveImports(
2941 struct symtab_command *symLC,
2942 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2943 unsigned long *indirectSyms,
2944 struct nlist *nlist)
2948 for(i=0;i*4<sect->size;i++)
2950 // according to otool, reserved1 contains the first index into the indirect symbol table
2951 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2952 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2955 if((symbol->n_type & N_TYPE) == N_UNDF
2956 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
2957 addr = (void*) (symbol->n_value);
2958 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
2961 addr = lookupSymbol(nm);
2964 fprintf(stderr, "not found: %s\n", nm);
2968 ((void**)(image + sect->offset))[i] = addr;
2972 static void relocateSection(char *image,
2973 struct symtab_command *symLC, struct nlist *nlist,
2974 struct section* sections, struct section *sect)
2976 struct relocation_info *relocs;
2979 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
2981 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
2985 relocs = (struct relocation_info*) (image + sect->reloff);
2989 if(relocs[i].r_address & R_SCATTERED)
2991 struct scattered_relocation_info *scat =
2992 (struct scattered_relocation_info*) &relocs[i];
2996 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
2998 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3000 *word = scat->r_value + sect->offset + ((long) image);
3004 continue; // FIXME: I hope it's OK to ignore all the others.
3008 struct relocation_info *reloc = &relocs[i];
3009 if(reloc->r_pcrel && !reloc->r_extern)
3012 if(!reloc->r_pcrel && reloc->r_length == 2)
3016 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3018 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3022 else if(reloc->r_type == PPC_RELOC_LO16)
3024 word = ((unsigned short*) wordPtr)[1];
3025 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3027 else if(reloc->r_type == PPC_RELOC_HI16)
3029 word = ((unsigned short*) wordPtr)[1] << 16;
3030 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3032 else if(reloc->r_type == PPC_RELOC_HA16)
3034 word = ((unsigned short*) wordPtr)[1] << 16;
3035 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3038 if(!reloc->r_extern)
3041 sections[reloc->r_symbolnum-1].offset
3042 - sections[reloc->r_symbolnum-1].addr
3049 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3050 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3051 word = (unsigned long) (lookupSymbol(nm));
3055 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3060 else if(reloc->r_type == PPC_RELOC_LO16)
3062 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3065 else if(reloc->r_type == PPC_RELOC_HI16)
3067 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3070 else if(reloc->r_type == PPC_RELOC_HA16)
3072 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3073 + ((word & (1<<15)) ? 1 : 0);
3078 fprintf(stderr, "unknown reloc\n");
3085 static int ocGetNames_MachO(ObjectCode* oc)
3087 char *image = (char*) oc->image;
3088 struct mach_header *header = (struct mach_header*) image;
3089 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3090 unsigned i,curSymbol;
3091 struct segment_command *segLC = NULL;
3092 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3093 struct symtab_command *symLC = NULL;
3094 struct dysymtab_command *dsymLC = NULL;
3095 struct nlist *nlist;
3096 unsigned long commonSize = 0;
3097 char *commonStorage = NULL;
3098 unsigned long commonCounter;
3100 for(i=0;i<header->ncmds;i++)
3102 if(lc->cmd == LC_SEGMENT)
3103 segLC = (struct segment_command*) lc;
3104 else if(lc->cmd == LC_SYMTAB)
3105 symLC = (struct symtab_command*) lc;
3106 else if(lc->cmd == LC_DYSYMTAB)
3107 dsymLC = (struct dysymtab_command*) lc;
3108 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3111 sections = (struct section*) (segLC+1);
3112 nlist = (struct nlist*) (image + symLC->symoff);
3114 for(i=0;i<segLC->nsects;i++)
3116 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3117 la_ptrs = §ions[i];
3118 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3119 nl_ptrs = §ions[i];
3121 // for now, only add __text and __const to the sections table
3122 else if(!strcmp(sections[i].sectname,"__text"))
3123 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3124 (void*) (image + sections[i].offset),
3125 (void*) (image + sections[i].offset + sections[i].size));
3126 else if(!strcmp(sections[i].sectname,"__const"))
3127 addSection(oc, SECTIONKIND_RWDATA,
3128 (void*) (image + sections[i].offset),
3129 (void*) (image + sections[i].offset + sections[i].size));
3130 else if(!strcmp(sections[i].sectname,"__data"))
3131 addSection(oc, SECTIONKIND_RWDATA,
3132 (void*) (image + sections[i].offset),
3133 (void*) (image + sections[i].offset + sections[i].size));
3136 // count external symbols defined here
3138 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3140 if((nlist[i].n_type & N_TYPE) == N_SECT)
3143 for(i=0;i<symLC->nsyms;i++)
3145 if((nlist[i].n_type & N_TYPE) == N_UNDF
3146 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3148 commonSize += nlist[i].n_value;
3152 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3153 "ocGetNames_MachO(oc->symbols)");
3155 // insert symbols into hash table
3156 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3158 if((nlist[i].n_type & N_TYPE) == N_SECT)
3160 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3161 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3162 sections[nlist[i].n_sect-1].offset
3163 - sections[nlist[i].n_sect-1].addr
3164 + nlist[i].n_value);
3165 oc->symbols[curSymbol++] = nm;
3169 // insert local symbols into lochash
3170 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3172 if((nlist[i].n_type & N_TYPE) == N_SECT)
3174 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3175 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3176 sections[nlist[i].n_sect-1].offset
3177 - sections[nlist[i].n_sect-1].addr
3178 + nlist[i].n_value);
3183 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3184 commonCounter = (unsigned long)commonStorage;
3185 for(i=0;i<symLC->nsyms;i++)
3187 if((nlist[i].n_type & N_TYPE) == N_UNDF
3188 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3190 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3191 unsigned long sz = nlist[i].n_value;
3193 nlist[i].n_value = commonCounter;
3195 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3196 oc->symbols[curSymbol++] = nm;
3198 commonCounter += sz;
3204 static int ocResolve_MachO(ObjectCode* oc)
3206 char *image = (char*) oc->image;
3207 struct mach_header *header = (struct mach_header*) image;
3208 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3210 struct segment_command *segLC = NULL;
3211 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3212 struct symtab_command *symLC = NULL;
3213 struct dysymtab_command *dsymLC = NULL;
3214 struct nlist *nlist;
3215 unsigned long *indirectSyms;
3217 for(i=0;i<header->ncmds;i++)
3219 if(lc->cmd == LC_SEGMENT)
3220 segLC = (struct segment_command*) lc;
3221 else if(lc->cmd == LC_SYMTAB)
3222 symLC = (struct symtab_command*) lc;
3223 else if(lc->cmd == LC_DYSYMTAB)
3224 dsymLC = (struct dysymtab_command*) lc;
3225 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3228 sections = (struct section*) (segLC+1);
3229 nlist = (struct nlist*) (image + symLC->symoff);
3231 for(i=0;i<segLC->nsects;i++)
3233 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3234 la_ptrs = §ions[i];
3235 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3236 nl_ptrs = §ions[i];
3239 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3242 resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist);
3244 resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist);
3246 for(i=0;i<segLC->nsects;i++)
3248 relocateSection(image,symLC,nlist,sections,§ions[i]);
3251 /* Free the local symbol table; we won't need it again. */
3252 freeHashTable(oc->lochash, NULL);