1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2000-2004
7 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.h"
13 // Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h>.
23 #include "LinkerInternals.h"
28 #ifdef HAVE_SYS_TYPES_H
29 #include <sys/types.h>
35 #ifdef HAVE_SYS_STAT_H
39 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
40 #include <HaskellSupport/dlfcn.h>
41 #elif defined(HAVE_DLFCN_H)
45 #if defined(cygwin32_TARGET_OS)
50 #ifdef HAVE_SYS_TIME_H
54 #include <sys/fcntl.h>
55 #include <sys/termios.h>
56 #include <sys/utime.h>
57 #include <sys/utsname.h>
61 #if defined(ia64_TARGET_ARCH) || defined(openbsd_TARGET_OS)
66 #if defined(openbsd_TARGET_OS)
74 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
75 # define OBJFORMAT_ELF
76 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
77 # define OBJFORMAT_PEi386
80 #elif defined(darwin_TARGET_OS)
81 # include <mach-o/ppc/reloc.h>
82 # define OBJFORMAT_MACHO
83 # include <mach-o/loader.h>
84 # include <mach-o/nlist.h>
85 # include <mach-o/reloc.h>
86 # include <mach-o/dyld.h>
89 /* Hash table mapping symbol names to Symbol */
90 static /*Str*/HashTable *symhash;
92 /* List of currently loaded objects */
93 ObjectCode *objects = NULL; /* initially empty */
95 #if defined(OBJFORMAT_ELF)
96 static int ocVerifyImage_ELF ( ObjectCode* oc );
97 static int ocGetNames_ELF ( ObjectCode* oc );
98 static int ocResolve_ELF ( ObjectCode* oc );
99 #elif defined(OBJFORMAT_PEi386)
100 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
101 static int ocGetNames_PEi386 ( ObjectCode* oc );
102 static int ocResolve_PEi386 ( ObjectCode* oc );
103 #elif defined(OBJFORMAT_MACHO)
104 static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
105 static int ocVerifyImage_MachO ( ObjectCode* oc );
106 static int ocGetNames_MachO ( ObjectCode* oc );
107 static int ocResolve_MachO ( ObjectCode* oc );
109 static void machoInitSymbolsWithoutUnderscore( void );
112 /* -----------------------------------------------------------------------------
113 * Built-in symbols from the RTS
116 typedef struct _RtsSymbolVal {
123 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
125 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
126 SymX(makeStableNamezh_fast) \
127 SymX(finalizzeWeakzh_fast)
129 /* These are not available in GUM!!! -- HWL */
130 #define Maybe_ForeignObj
131 #define Maybe_Stable_Names
134 #if !defined (mingw32_TARGET_OS)
135 #define RTS_POSIX_ONLY_SYMBOLS \
136 SymX(stg_sig_install) \
140 #if defined (cygwin32_TARGET_OS)
141 #define RTS_MINGW_ONLY_SYMBOLS /**/
142 /* Don't have the ability to read import libs / archives, so
143 * we have to stupidly list a lot of what libcygwin.a
146 #define RTS_CYGWIN_ONLY_SYMBOLS \
224 #elif !defined(mingw32_TARGET_OS)
225 #define RTS_MINGW_ONLY_SYMBOLS /**/
226 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
227 #else /* defined(mingw32_TARGET_OS) */
228 #define RTS_POSIX_ONLY_SYMBOLS /**/
229 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
231 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
233 #define RTS_MINGW_EXTRA_SYMS \
234 Sym(_imp____mb_cur_max) \
237 #define RTS_MINGW_EXTRA_SYMS
240 /* These are statically linked from the mingw libraries into the ghc
241 executable, so we have to employ this hack. */
242 #define RTS_MINGW_ONLY_SYMBOLS \
243 SymX(asyncReadzh_fast) \
244 SymX(asyncWritezh_fast) \
245 SymX(asyncDoProczh_fast) \
257 SymX(getservbyname) \
258 SymX(getservbyport) \
259 SymX(getprotobynumber) \
260 SymX(getprotobyname) \
261 SymX(gethostbyname) \
262 SymX(gethostbyaddr) \
297 Sym(_imp___timezone) \
305 RTS_MINGW_EXTRA_SYMS \
310 # define MAIN_CAP_SYM SymX(MainCapability)
312 # define MAIN_CAP_SYM
315 #ifdef TABLES_NEXT_TO_CODE
316 #define RTS_RET_SYMBOLS /* nothing */
318 #define RTS_RET_SYMBOLS \
319 SymX(stg_enter_ret) \
320 SymX(stg_gc_fun_ret) \
328 SymX(stg_ap_pv_ret) \
329 SymX(stg_ap_pp_ret) \
330 SymX(stg_ap_ppv_ret) \
331 SymX(stg_ap_ppp_ret) \
332 SymX(stg_ap_pppv_ret) \
333 SymX(stg_ap_pppp_ret) \
334 SymX(stg_ap_ppppp_ret) \
335 SymX(stg_ap_pppppp_ret)
338 #define RTS_SYMBOLS \
342 SymX(stg_enter_info) \
343 SymX(stg_gc_void_info) \
344 SymX(__stg_gc_enter_1) \
345 SymX(stg_gc_noregs) \
346 SymX(stg_gc_unpt_r1_info) \
347 SymX(stg_gc_unpt_r1) \
348 SymX(stg_gc_unbx_r1_info) \
349 SymX(stg_gc_unbx_r1) \
350 SymX(stg_gc_f1_info) \
352 SymX(stg_gc_d1_info) \
354 SymX(stg_gc_l1_info) \
357 SymX(stg_gc_fun_info) \
359 SymX(stg_gc_gen_info) \
360 SymX(stg_gc_gen_hp) \
362 SymX(stg_gen_yield) \
363 SymX(stg_yield_noregs) \
364 SymX(stg_yield_to_interpreter) \
365 SymX(stg_gen_block) \
366 SymX(stg_block_noregs) \
368 SymX(stg_block_takemvar) \
369 SymX(stg_block_putmvar) \
370 SymX(stg_seq_frame_info) \
372 SymX(MallocFailHook) \
374 SymX(OutOfHeapHook) \
375 SymX(StackOverflowHook) \
376 SymX(__encodeDouble) \
377 SymX(__encodeFloat) \
381 SymX(__gmpz_cmp_si) \
382 SymX(__gmpz_cmp_ui) \
383 SymX(__gmpz_get_si) \
384 SymX(__gmpz_get_ui) \
385 SymX(__int_encodeDouble) \
386 SymX(__int_encodeFloat) \
387 SymX(andIntegerzh_fast) \
389 SymX(blockAsyncExceptionszh_fast) \
391 SymX(closure_flags) \
393 SymX(cmpIntegerzh_fast) \
394 SymX(cmpIntegerIntzh_fast) \
395 SymX(complementIntegerzh_fast) \
396 SymX(createAdjustor) \
397 SymX(decodeDoublezh_fast) \
398 SymX(decodeFloatzh_fast) \
401 SymX(deRefWeakzh_fast) \
402 SymX(deRefStablePtrzh_fast) \
403 SymX(divExactIntegerzh_fast) \
404 SymX(divModIntegerzh_fast) \
407 SymX(forkOS_createThread) \
408 SymX(freeHaskellFunctionPtr) \
409 SymX(freeStablePtr) \
410 SymX(gcdIntegerzh_fast) \
411 SymX(gcdIntegerIntzh_fast) \
412 SymX(gcdIntzh_fast) \
417 SymX(int2Integerzh_fast) \
418 SymX(integer2Intzh_fast) \
419 SymX(integer2Wordzh_fast) \
420 SymX(isCurrentThreadBoundzh_fast) \
421 SymX(isDoubleDenormalized) \
422 SymX(isDoubleInfinite) \
424 SymX(isDoubleNegativeZero) \
425 SymX(isEmptyMVarzh_fast) \
426 SymX(isFloatDenormalized) \
427 SymX(isFloatInfinite) \
429 SymX(isFloatNegativeZero) \
430 SymX(killThreadzh_fast) \
433 SymX(makeStablePtrzh_fast) \
434 SymX(minusIntegerzh_fast) \
435 SymX(mkApUpd0zh_fast) \
436 SymX(myThreadIdzh_fast) \
437 SymX(labelThreadzh_fast) \
438 SymX(newArrayzh_fast) \
439 SymX(newBCOzh_fast) \
440 SymX(newByteArrayzh_fast) \
441 SymX_redirect(newCAF, newDynCAF) \
442 SymX(newMVarzh_fast) \
443 SymX(newMutVarzh_fast) \
444 SymX(atomicModifyMutVarzh_fast) \
445 SymX(newPinnedByteArrayzh_fast) \
446 SymX(orIntegerzh_fast) \
448 SymX(performMajorGC) \
449 SymX(plusIntegerzh_fast) \
452 SymX(putMVarzh_fast) \
453 SymX(quotIntegerzh_fast) \
454 SymX(quotRemIntegerzh_fast) \
456 SymX(raiseIOzh_fast) \
457 SymX(remIntegerzh_fast) \
458 SymX(resetNonBlockingFd) \
462 SymX(rts_checkSchedStatus) \
465 SymX(rts_evalLazyIO) \
466 SymX(rts_evalStableIO) \
470 SymX(rts_getDouble) \
475 SymX(rts_getFunPtr) \
476 SymX(rts_getStablePtr) \
477 SymX(rts_getThreadId) \
479 SymX(rts_getWord32) \
492 SymX(rts_mkStablePtr) \
500 SymX(rtsSupportsBoundThreads) \
502 SymX(__hscore_get_saved_termios) \
503 SymX(__hscore_set_saved_termios) \
505 SymX(startupHaskell) \
506 SymX(shutdownHaskell) \
507 SymX(shutdownHaskellAndExit) \
508 SymX(stable_ptr_table) \
509 SymX(stackOverflow) \
510 SymX(stg_CAF_BLACKHOLE_info) \
511 SymX(stg_BLACKHOLE_BQ_info) \
512 SymX(awakenBlockedQueue) \
513 SymX(stg_CHARLIKE_closure) \
514 SymX(stg_EMPTY_MVAR_info) \
515 SymX(stg_IND_STATIC_info) \
516 SymX(stg_INTLIKE_closure) \
517 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
518 SymX(stg_WEAK_info) \
519 SymX(stg_ap_0_info) \
520 SymX(stg_ap_v_info) \
521 SymX(stg_ap_f_info) \
522 SymX(stg_ap_d_info) \
523 SymX(stg_ap_l_info) \
524 SymX(stg_ap_n_info) \
525 SymX(stg_ap_p_info) \
526 SymX(stg_ap_pv_info) \
527 SymX(stg_ap_pp_info) \
528 SymX(stg_ap_ppv_info) \
529 SymX(stg_ap_ppp_info) \
530 SymX(stg_ap_pppv_info) \
531 SymX(stg_ap_pppp_info) \
532 SymX(stg_ap_ppppp_info) \
533 SymX(stg_ap_pppppp_info) \
534 SymX(stg_ap_1_upd_info) \
535 SymX(stg_ap_2_upd_info) \
536 SymX(stg_ap_3_upd_info) \
537 SymX(stg_ap_4_upd_info) \
538 SymX(stg_ap_5_upd_info) \
539 SymX(stg_ap_6_upd_info) \
540 SymX(stg_ap_7_upd_info) \
542 SymX(stg_sel_0_upd_info) \
543 SymX(stg_sel_10_upd_info) \
544 SymX(stg_sel_11_upd_info) \
545 SymX(stg_sel_12_upd_info) \
546 SymX(stg_sel_13_upd_info) \
547 SymX(stg_sel_14_upd_info) \
548 SymX(stg_sel_15_upd_info) \
549 SymX(stg_sel_1_upd_info) \
550 SymX(stg_sel_2_upd_info) \
551 SymX(stg_sel_3_upd_info) \
552 SymX(stg_sel_4_upd_info) \
553 SymX(stg_sel_5_upd_info) \
554 SymX(stg_sel_6_upd_info) \
555 SymX(stg_sel_7_upd_info) \
556 SymX(stg_sel_8_upd_info) \
557 SymX(stg_sel_9_upd_info) \
558 SymX(stg_upd_frame_info) \
559 SymX(suspendThread) \
560 SymX(takeMVarzh_fast) \
561 SymX(timesIntegerzh_fast) \
562 SymX(tryPutMVarzh_fast) \
563 SymX(tryTakeMVarzh_fast) \
564 SymX(unblockAsyncExceptionszh_fast) \
566 SymX(unsafeThawArrayzh_fast) \
567 SymX(waitReadzh_fast) \
568 SymX(waitWritezh_fast) \
569 SymX(word2Integerzh_fast) \
570 SymX(xorIntegerzh_fast) \
573 #ifdef SUPPORT_LONG_LONGS
574 #define RTS_LONG_LONG_SYMS \
575 SymX(int64ToIntegerzh_fast) \
576 SymX(word64ToIntegerzh_fast)
578 #define RTS_LONG_LONG_SYMS /* nothing */
581 // 64-bit support functions in libgcc.a
582 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
583 #define RTS_LIBGCC_SYMBOLS \
592 #elif defined(ia64_TARGET_ARCH)
593 #define RTS_LIBGCC_SYMBOLS \
601 #define RTS_LIBGCC_SYMBOLS
604 #ifdef darwin_TARGET_OS
605 // Symbols that don't have a leading underscore
606 // on Mac OS X. They have to receive special treatment,
607 // see machoInitSymbolsWithoutUnderscore()
608 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
613 /* entirely bogus claims about types of these symbols */
614 #define Sym(vvv) extern void vvv(void);
615 #define SymX(vvv) /**/
616 #define SymX_redirect(vvv,xxx) /**/
620 RTS_POSIX_ONLY_SYMBOLS
621 RTS_MINGW_ONLY_SYMBOLS
622 RTS_CYGWIN_ONLY_SYMBOLS
628 #ifdef LEADING_UNDERSCORE
629 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
631 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
634 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
636 #define SymX(vvv) Sym(vvv)
638 // SymX_redirect allows us to redirect references to one symbol to
639 // another symbol. See newCAF/newDynCAF for an example.
640 #define SymX_redirect(vvv,xxx) \
641 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
644 static RtsSymbolVal rtsSyms[] = {
648 RTS_POSIX_ONLY_SYMBOLS
649 RTS_MINGW_ONLY_SYMBOLS
650 RTS_CYGWIN_ONLY_SYMBOLS
652 { 0, 0 } /* sentinel */
655 /* -----------------------------------------------------------------------------
656 * Insert symbols into hash tables, checking for duplicates.
658 static void ghciInsertStrHashTable ( char* obj_name,
664 if (lookupHashTable(table, (StgWord)key) == NULL)
666 insertStrHashTable(table, (StgWord)key, data);
671 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
673 "whilst processing object file\n"
675 "This could be caused by:\n"
676 " * Loading two different object files which export the same symbol\n"
677 " * Specifying the same object file twice on the GHCi command line\n"
678 " * An incorrect `package.conf' entry, causing some object to be\n"
680 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
689 /* -----------------------------------------------------------------------------
690 * initialize the object linker
694 static int linker_init_done = 0 ;
696 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
697 static void *dl_prog_handle;
700 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
701 #if defined(openbsd_TARGET_OS)
702 static void *dl_libc_handle;
710 /* Make initLinker idempotent, so we can call it
711 before evey relevant operation; that means we
712 don't need to initialise the linker separately */
713 if (linker_init_done == 1) { return; } else {
714 linker_init_done = 1;
717 symhash = allocStrHashTable();
719 /* populate the symbol table with stuff from the RTS */
720 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
721 ghciInsertStrHashTable("(GHCi built-in symbols)",
722 symhash, sym->lbl, sym->addr);
724 # if defined(OBJFORMAT_MACHO)
725 machoInitSymbolsWithoutUnderscore();
728 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
729 # if defined(RTLD_DEFAULT)
730 dl_prog_handle = RTLD_DEFAULT;
732 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
733 # if defined(openbsd_TARGET_OS)
734 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
736 # endif // RTLD_DEFAULT
740 /* -----------------------------------------------------------------------------
741 * Loading DLL or .so dynamic libraries
742 * -----------------------------------------------------------------------------
744 * Add a DLL from which symbols may be found. In the ELF case, just
745 * do RTLD_GLOBAL-style add, so no further messing around needs to
746 * happen in order that symbols in the loaded .so are findable --
747 * lookupSymbol() will subsequently see them by dlsym on the program's
748 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
750 * In the PEi386 case, open the DLLs and put handles to them in a
751 * linked list. When looking for a symbol, try all handles in the
752 * list. This means that we need to load even DLLs that are guaranteed
753 * to be in the ghc.exe image already, just so we can get a handle
754 * to give to loadSymbol, so that we can find the symbols. For such
755 * libraries, the LoadLibrary call should be a no-op except for returning
760 #if defined(OBJFORMAT_PEi386)
761 /* A record for storing handles into DLLs. */
766 struct _OpenedDLL* next;
771 /* A list thereof. */
772 static OpenedDLL* opened_dlls = NULL;
776 addDLL( char *dll_name )
778 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
779 /* ------------------- ELF DLL loader ------------------- */
785 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
788 /* dlopen failed; return a ptr to the error msg. */
790 if (errmsg == NULL) errmsg = "addDLL: unknown error";
797 # elif defined(OBJFORMAT_PEi386)
798 /* ------------------- Win32 DLL loader ------------------- */
806 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
808 /* See if we've already got it, and ignore if so. */
809 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
810 if (0 == strcmp(o_dll->name, dll_name))
814 /* The file name has no suffix (yet) so that we can try
815 both foo.dll and foo.drv
817 The documentation for LoadLibrary says:
818 If no file name extension is specified in the lpFileName
819 parameter, the default library extension .dll is
820 appended. However, the file name string can include a trailing
821 point character (.) to indicate that the module name has no
824 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
825 sprintf(buf, "%s.DLL", dll_name);
826 instance = LoadLibrary(buf);
827 if (instance == NULL) {
828 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
829 instance = LoadLibrary(buf);
830 if (instance == NULL) {
833 /* LoadLibrary failed; return a ptr to the error msg. */
834 return "addDLL: unknown error";
839 /* Add this DLL to the list of DLLs in which to search for symbols. */
840 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
841 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
842 strcpy(o_dll->name, dll_name);
843 o_dll->instance = instance;
844 o_dll->next = opened_dlls;
849 barf("addDLL: not implemented on this platform");
853 /* -----------------------------------------------------------------------------
854 * lookup a symbol in the hash table
857 lookupSymbol( char *lbl )
861 ASSERT(symhash != NULL);
862 val = lookupStrHashTable(symhash, lbl);
865 # if defined(OBJFORMAT_ELF)
866 # if defined(openbsd_TARGET_OS)
867 val = dlsym(dl_prog_handle, lbl);
868 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
869 # else /* not openbsd */
870 return dlsym(dl_prog_handle, lbl);
872 # elif defined(OBJFORMAT_MACHO)
873 if(NSIsSymbolNameDefined(lbl)) {
874 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
875 return NSAddressOfSymbol(symbol);
879 # elif defined(OBJFORMAT_PEi386)
882 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
883 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
885 /* HACK: if the name has an initial underscore, try stripping
886 it off & look that up first. I've yet to verify whether there's
887 a Rule that governs whether an initial '_' *should always* be
888 stripped off when mapping from import lib name to the DLL name.
890 sym = GetProcAddress(o_dll->instance, (lbl+1));
892 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
896 sym = GetProcAddress(o_dll->instance, lbl);
898 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
913 __attribute((unused))
915 lookupLocalSymbol( ObjectCode* oc, char *lbl )
919 val = lookupStrHashTable(oc->lochash, lbl);
929 /* -----------------------------------------------------------------------------
930 * Debugging aid: look in GHCi's object symbol tables for symbols
931 * within DELTA bytes of the specified address, and show their names.
934 void ghci_enquire ( char* addr );
936 void ghci_enquire ( char* addr )
941 const int DELTA = 64;
946 for (oc = objects; oc; oc = oc->next) {
947 for (i = 0; i < oc->n_symbols; i++) {
948 sym = oc->symbols[i];
949 if (sym == NULL) continue;
950 // debugBelch("enquire %p %p\n", sym, oc->lochash);
952 if (oc->lochash != NULL) {
953 a = lookupStrHashTable(oc->lochash, sym);
956 a = lookupStrHashTable(symhash, sym);
959 // debugBelch("ghci_enquire: can't find %s\n", sym);
961 else if (addr-DELTA <= a && a <= addr+DELTA) {
962 debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
969 #ifdef ia64_TARGET_ARCH
970 static unsigned int PLTSize(void);
973 /* -----------------------------------------------------------------------------
974 * Load an obj (populate the global symbol table, but don't resolve yet)
976 * Returns: 1 if ok, 0 on error.
979 loadObj( char *path )
986 void *map_addr = NULL;
993 /* debugBelch("loadObj %s\n", path ); */
995 /* Check that we haven't already loaded this object.
996 Ignore requests to load multiple times */
1000 for (o = objects; o; o = o->next) {
1001 if (0 == strcmp(o->fileName, path)) {
1003 break; /* don't need to search further */
1007 IF_DEBUG(linker, debugBelch(
1008 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1009 "same object file twice:\n"
1011 "GHCi will ignore this, but be warned.\n"
1013 return 1; /* success */
1017 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1019 # if defined(OBJFORMAT_ELF)
1020 oc->formatName = "ELF";
1021 # elif defined(OBJFORMAT_PEi386)
1022 oc->formatName = "PEi386";
1023 # elif defined(OBJFORMAT_MACHO)
1024 oc->formatName = "Mach-O";
1027 barf("loadObj: not implemented on this platform");
1030 r = stat(path, &st);
1031 if (r == -1) { return 0; }
1033 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1034 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1035 strcpy(oc->fileName, path);
1037 oc->fileSize = st.st_size;
1039 oc->sections = NULL;
1040 oc->lochash = allocStrHashTable();
1041 oc->proddables = NULL;
1043 /* chain it onto the list of objects */
1048 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1050 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1052 #if defined(openbsd_TARGET_OS)
1053 fd = open(path, O_RDONLY, S_IRUSR);
1055 fd = open(path, O_RDONLY);
1058 barf("loadObj: can't open `%s'", path);
1060 pagesize = getpagesize();
1062 #ifdef ia64_TARGET_ARCH
1063 /* The PLT needs to be right before the object */
1064 n = ROUND_UP(PLTSize(), pagesize);
1065 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1066 if (oc->plt == MAP_FAILED)
1067 barf("loadObj: can't allocate PLT");
1070 map_addr = oc->plt + n;
1073 n = ROUND_UP(oc->fileSize, pagesize);
1074 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1075 if (oc->image == MAP_FAILED)
1076 barf("loadObj: can't map `%s'", path);
1080 #else /* !USE_MMAP */
1082 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1084 /* load the image into memory */
1085 f = fopen(path, "rb");
1087 barf("loadObj: can't read `%s'", path);
1089 n = fread ( oc->image, 1, oc->fileSize, f );
1090 if (n != oc->fileSize)
1091 barf("loadObj: error whilst reading `%s'", path);
1095 #endif /* USE_MMAP */
1097 # if defined(OBJFORMAT_MACHO)
1098 r = ocAllocateJumpIslands_MachO ( oc );
1099 if (!r) { return r; }
1102 /* verify the in-memory image */
1103 # if defined(OBJFORMAT_ELF)
1104 r = ocVerifyImage_ELF ( oc );
1105 # elif defined(OBJFORMAT_PEi386)
1106 r = ocVerifyImage_PEi386 ( oc );
1107 # elif defined(OBJFORMAT_MACHO)
1108 r = ocVerifyImage_MachO ( oc );
1110 barf("loadObj: no verify method");
1112 if (!r) { return r; }
1114 /* build the symbol list for this image */
1115 # if defined(OBJFORMAT_ELF)
1116 r = ocGetNames_ELF ( oc );
1117 # elif defined(OBJFORMAT_PEi386)
1118 r = ocGetNames_PEi386 ( oc );
1119 # elif defined(OBJFORMAT_MACHO)
1120 r = ocGetNames_MachO ( oc );
1122 barf("loadObj: no getNames method");
1124 if (!r) { return r; }
1126 /* loaded, but not resolved yet */
1127 oc->status = OBJECT_LOADED;
1132 /* -----------------------------------------------------------------------------
1133 * resolve all the currently unlinked objects in memory
1135 * Returns: 1 if ok, 0 on error.
1145 for (oc = objects; oc; oc = oc->next) {
1146 if (oc->status != OBJECT_RESOLVED) {
1147 # if defined(OBJFORMAT_ELF)
1148 r = ocResolve_ELF ( oc );
1149 # elif defined(OBJFORMAT_PEi386)
1150 r = ocResolve_PEi386 ( oc );
1151 # elif defined(OBJFORMAT_MACHO)
1152 r = ocResolve_MachO ( oc );
1154 barf("resolveObjs: not implemented on this platform");
1156 if (!r) { return r; }
1157 oc->status = OBJECT_RESOLVED;
1163 /* -----------------------------------------------------------------------------
1164 * delete an object from the pool
1167 unloadObj( char *path )
1169 ObjectCode *oc, *prev;
1171 ASSERT(symhash != NULL);
1172 ASSERT(objects != NULL);
1177 for (oc = objects; oc; prev = oc, oc = oc->next) {
1178 if (!strcmp(oc->fileName,path)) {
1180 /* Remove all the mappings for the symbols within this
1185 for (i = 0; i < oc->n_symbols; i++) {
1186 if (oc->symbols[i] != NULL) {
1187 removeStrHashTable(symhash, oc->symbols[i], NULL);
1195 prev->next = oc->next;
1198 /* We're going to leave this in place, in case there are
1199 any pointers from the heap into it: */
1200 /* stgFree(oc->image); */
1201 stgFree(oc->fileName);
1202 stgFree(oc->symbols);
1203 stgFree(oc->sections);
1204 /* The local hash table should have been freed at the end
1205 of the ocResolve_ call on it. */
1206 ASSERT(oc->lochash == NULL);
1212 errorBelch("unloadObj: can't find `%s' to unload", path);
1216 /* -----------------------------------------------------------------------------
1217 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1218 * which may be prodded during relocation, and abort if we try and write
1219 * outside any of these.
1221 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1224 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1225 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1229 pb->next = oc->proddables;
1230 oc->proddables = pb;
1233 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1236 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1237 char* s = (char*)(pb->start);
1238 char* e = s + pb->size - 1;
1239 char* a = (char*)addr;
1240 /* Assumes that the biggest fixup involves a 4-byte write. This
1241 probably needs to be changed to 8 (ie, +7) on 64-bit
1243 if (a >= s && (a+3) <= e) return;
1245 barf("checkProddableBlock: invalid fixup in runtime linker");
1248 /* -----------------------------------------------------------------------------
1249 * Section management.
1251 static void addSection ( ObjectCode* oc, SectionKind kind,
1252 void* start, void* end )
1254 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1258 s->next = oc->sections;
1261 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1262 start, ((char*)end)-1, end - start + 1, kind );
1268 /* --------------------------------------------------------------------------
1269 * PEi386 specifics (Win32 targets)
1270 * ------------------------------------------------------------------------*/
1272 /* The information for this linker comes from
1273 Microsoft Portable Executable
1274 and Common Object File Format Specification
1275 revision 5.1 January 1998
1276 which SimonM says comes from the MS Developer Network CDs.
1278 It can be found there (on older CDs), but can also be found
1281 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1283 (this is Rev 6.0 from February 1999).
1285 Things move, so if that fails, try searching for it via
1287 http://www.google.com/search?q=PE+COFF+specification
1289 The ultimate reference for the PE format is the Winnt.h
1290 header file that comes with the Platform SDKs; as always,
1291 implementations will drift wrt their documentation.
1293 A good background article on the PE format is Matt Pietrek's
1294 March 1994 article in Microsoft System Journal (MSJ)
1295 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1296 Win32 Portable Executable File Format." The info in there
1297 has recently been updated in a two part article in
1298 MSDN magazine, issues Feb and March 2002,
1299 "Inside Windows: An In-Depth Look into the Win32 Portable
1300 Executable File Format"
1302 John Levine's book "Linkers and Loaders" contains useful
1307 #if defined(OBJFORMAT_PEi386)
1311 typedef unsigned char UChar;
1312 typedef unsigned short UInt16;
1313 typedef unsigned int UInt32;
1320 UInt16 NumberOfSections;
1321 UInt32 TimeDateStamp;
1322 UInt32 PointerToSymbolTable;
1323 UInt32 NumberOfSymbols;
1324 UInt16 SizeOfOptionalHeader;
1325 UInt16 Characteristics;
1329 #define sizeof_COFF_header 20
1336 UInt32 VirtualAddress;
1337 UInt32 SizeOfRawData;
1338 UInt32 PointerToRawData;
1339 UInt32 PointerToRelocations;
1340 UInt32 PointerToLinenumbers;
1341 UInt16 NumberOfRelocations;
1342 UInt16 NumberOfLineNumbers;
1343 UInt32 Characteristics;
1347 #define sizeof_COFF_section 40
1354 UInt16 SectionNumber;
1357 UChar NumberOfAuxSymbols;
1361 #define sizeof_COFF_symbol 18
1366 UInt32 VirtualAddress;
1367 UInt32 SymbolTableIndex;
1372 #define sizeof_COFF_reloc 10
1375 /* From PE spec doc, section 3.3.2 */
1376 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1377 windows.h -- for the same purpose, but I want to know what I'm
1379 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1380 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1381 #define MYIMAGE_FILE_DLL 0x2000
1382 #define MYIMAGE_FILE_SYSTEM 0x1000
1383 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1384 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1385 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1387 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1388 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1389 #define MYIMAGE_SYM_CLASS_STATIC 3
1390 #define MYIMAGE_SYM_UNDEFINED 0
1392 /* From PE spec doc, section 4.1 */
1393 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1394 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1395 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1397 /* From PE spec doc, section 5.2.1 */
1398 #define MYIMAGE_REL_I386_DIR32 0x0006
1399 #define MYIMAGE_REL_I386_REL32 0x0014
1402 /* We use myindex to calculate array addresses, rather than
1403 simply doing the normal subscript thing. That's because
1404 some of the above structs have sizes which are not
1405 a whole number of words. GCC rounds their sizes up to a
1406 whole number of words, which means that the address calcs
1407 arising from using normal C indexing or pointer arithmetic
1408 are just plain wrong. Sigh.
1411 myindex ( int scale, void* base, int index )
1414 ((UChar*)base) + scale * index;
1419 printName ( UChar* name, UChar* strtab )
1421 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1422 UInt32 strtab_offset = * (UInt32*)(name+4);
1423 debugBelch("%s", strtab + strtab_offset );
1426 for (i = 0; i < 8; i++) {
1427 if (name[i] == 0) break;
1428 debugBelch("%c", name[i] );
1435 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1437 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1438 UInt32 strtab_offset = * (UInt32*)(name+4);
1439 strncpy ( dst, strtab+strtab_offset, dstSize );
1445 if (name[i] == 0) break;
1455 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1458 /* If the string is longer than 8 bytes, look in the
1459 string table for it -- this will be correctly zero terminated.
1461 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1462 UInt32 strtab_offset = * (UInt32*)(name+4);
1463 return ((UChar*)strtab) + strtab_offset;
1465 /* Otherwise, if shorter than 8 bytes, return the original,
1466 which by defn is correctly terminated.
1468 if (name[7]==0) return name;
1469 /* The annoying case: 8 bytes. Copy into a temporary
1470 (which is never freed ...)
1472 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1474 strncpy(newstr,name,8);
1480 /* Just compares the short names (first 8 chars) */
1481 static COFF_section *
1482 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1486 = (COFF_header*)(oc->image);
1487 COFF_section* sectab
1489 ((UChar*)(oc->image))
1490 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1492 for (i = 0; i < hdr->NumberOfSections; i++) {
1495 COFF_section* section_i
1497 myindex ( sizeof_COFF_section, sectab, i );
1498 n1 = (UChar*) &(section_i->Name);
1500 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1501 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1502 n1[6]==n2[6] && n1[7]==n2[7])
1511 zapTrailingAtSign ( UChar* sym )
1513 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1515 if (sym[0] == 0) return;
1517 while (sym[i] != 0) i++;
1520 while (j > 0 && my_isdigit(sym[j])) j--;
1521 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1527 ocVerifyImage_PEi386 ( ObjectCode* oc )
1532 COFF_section* sectab;
1533 COFF_symbol* symtab;
1535 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1536 hdr = (COFF_header*)(oc->image);
1537 sectab = (COFF_section*) (
1538 ((UChar*)(oc->image))
1539 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1541 symtab = (COFF_symbol*) (
1542 ((UChar*)(oc->image))
1543 + hdr->PointerToSymbolTable
1545 strtab = ((UChar*)symtab)
1546 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1548 if (hdr->Machine != 0x14c) {
1549 errorBelch("Not x86 PEi386");
1552 if (hdr->SizeOfOptionalHeader != 0) {
1553 errorBelch("PEi386 with nonempty optional header");
1556 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1557 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1558 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1559 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1560 errorBelch("Not a PEi386 object file");
1563 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1564 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1565 errorBelch("Invalid PEi386 word size or endiannness: %d",
1566 (int)(hdr->Characteristics));
1569 /* If the string table size is way crazy, this might indicate that
1570 there are more than 64k relocations, despite claims to the
1571 contrary. Hence this test. */
1572 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1574 if ( (*(UInt32*)strtab) > 600000 ) {
1575 /* Note that 600k has no special significance other than being
1576 big enough to handle the almost-2MB-sized lumps that
1577 constitute HSwin32*.o. */
1578 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1583 /* No further verification after this point; only debug printing. */
1585 IF_DEBUG(linker, i=1);
1586 if (i == 0) return 1;
1588 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1589 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1590 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1593 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1594 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1595 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1596 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1597 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1598 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1599 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1601 /* Print the section table. */
1603 for (i = 0; i < hdr->NumberOfSections; i++) {
1605 COFF_section* sectab_i
1607 myindex ( sizeof_COFF_section, sectab, i );
1614 printName ( sectab_i->Name, strtab );
1624 sectab_i->VirtualSize,
1625 sectab_i->VirtualAddress,
1626 sectab_i->SizeOfRawData,
1627 sectab_i->PointerToRawData,
1628 sectab_i->NumberOfRelocations,
1629 sectab_i->PointerToRelocations,
1630 sectab_i->PointerToRawData
1632 reltab = (COFF_reloc*) (
1633 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1636 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1637 /* If the relocation field (a short) has overflowed, the
1638 * real count can be found in the first reloc entry.
1640 * See Section 4.1 (last para) of the PE spec (rev6.0).
1642 COFF_reloc* rel = (COFF_reloc*)
1643 myindex ( sizeof_COFF_reloc, reltab, 0 );
1644 noRelocs = rel->VirtualAddress;
1647 noRelocs = sectab_i->NumberOfRelocations;
1651 for (; j < noRelocs; j++) {
1653 COFF_reloc* rel = (COFF_reloc*)
1654 myindex ( sizeof_COFF_reloc, reltab, j );
1656 " type 0x%-4x vaddr 0x%-8x name `",
1658 rel->VirtualAddress );
1659 sym = (COFF_symbol*)
1660 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1661 /* Hmm..mysterious looking offset - what's it for? SOF */
1662 printName ( sym->Name, strtab -10 );
1669 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
1670 debugBelch("---START of string table---\n");
1671 for (i = 4; i < *(Int32*)strtab; i++) {
1673 debugBelch("\n"); else
1674 debugBelch("%c", strtab[i] );
1676 debugBelch("--- END of string table---\n");
1681 COFF_symbol* symtab_i;
1682 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1683 symtab_i = (COFF_symbol*)
1684 myindex ( sizeof_COFF_symbol, symtab, i );
1690 printName ( symtab_i->Name, strtab );
1699 (Int32)(symtab_i->SectionNumber),
1700 (UInt32)symtab_i->Type,
1701 (UInt32)symtab_i->StorageClass,
1702 (UInt32)symtab_i->NumberOfAuxSymbols
1704 i += symtab_i->NumberOfAuxSymbols;
1714 ocGetNames_PEi386 ( ObjectCode* oc )
1717 COFF_section* sectab;
1718 COFF_symbol* symtab;
1725 hdr = (COFF_header*)(oc->image);
1726 sectab = (COFF_section*) (
1727 ((UChar*)(oc->image))
1728 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1730 symtab = (COFF_symbol*) (
1731 ((UChar*)(oc->image))
1732 + hdr->PointerToSymbolTable
1734 strtab = ((UChar*)(oc->image))
1735 + hdr->PointerToSymbolTable
1736 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1738 /* Allocate space for any (local, anonymous) .bss sections. */
1740 for (i = 0; i < hdr->NumberOfSections; i++) {
1742 COFF_section* sectab_i
1744 myindex ( sizeof_COFF_section, sectab, i );
1745 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1746 if (sectab_i->VirtualSize == 0) continue;
1747 /* This is a non-empty .bss section. Allocate zeroed space for
1748 it, and set its PointerToRawData field such that oc->image +
1749 PointerToRawData == addr_of_zeroed_space. */
1750 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1751 "ocGetNames_PEi386(anonymous bss)");
1752 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1753 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1754 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
1757 /* Copy section information into the ObjectCode. */
1759 for (i = 0; i < hdr->NumberOfSections; i++) {
1765 = SECTIONKIND_OTHER;
1766 COFF_section* sectab_i
1768 myindex ( sizeof_COFF_section, sectab, i );
1769 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
1772 /* I'm sure this is the Right Way to do it. However, the
1773 alternative of testing the sectab_i->Name field seems to
1774 work ok with Cygwin.
1776 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1777 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1778 kind = SECTIONKIND_CODE_OR_RODATA;
1781 if (0==strcmp(".text",sectab_i->Name) ||
1782 0==strcmp(".rodata",sectab_i->Name))
1783 kind = SECTIONKIND_CODE_OR_RODATA;
1784 if (0==strcmp(".data",sectab_i->Name) ||
1785 0==strcmp(".bss",sectab_i->Name))
1786 kind = SECTIONKIND_RWDATA;
1788 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1789 sz = sectab_i->SizeOfRawData;
1790 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1792 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1793 end = start + sz - 1;
1795 if (kind == SECTIONKIND_OTHER
1796 /* Ignore sections called which contain stabs debugging
1798 && 0 != strcmp(".stab", sectab_i->Name)
1799 && 0 != strcmp(".stabstr", sectab_i->Name)
1801 errorBelch("Unknown PEi386 section name `%s'", sectab_i->Name);
1805 if (kind != SECTIONKIND_OTHER && end >= start) {
1806 addSection(oc, kind, start, end);
1807 addProddableBlock(oc, start, end - start + 1);
1811 /* Copy exported symbols into the ObjectCode. */
1813 oc->n_symbols = hdr->NumberOfSymbols;
1814 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1815 "ocGetNames_PEi386(oc->symbols)");
1816 /* Call me paranoid; I don't care. */
1817 for (i = 0; i < oc->n_symbols; i++)
1818 oc->symbols[i] = NULL;
1822 COFF_symbol* symtab_i;
1823 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1824 symtab_i = (COFF_symbol*)
1825 myindex ( sizeof_COFF_symbol, symtab, i );
1829 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1830 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1831 /* This symbol is global and defined, viz, exported */
1832 /* for MYIMAGE_SYMCLASS_EXTERNAL
1833 && !MYIMAGE_SYM_UNDEFINED,
1834 the address of the symbol is:
1835 address of relevant section + offset in section
1837 COFF_section* sectabent
1838 = (COFF_section*) myindex ( sizeof_COFF_section,
1840 symtab_i->SectionNumber-1 );
1841 addr = ((UChar*)(oc->image))
1842 + (sectabent->PointerToRawData
1846 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1847 && symtab_i->Value > 0) {
1848 /* This symbol isn't in any section at all, ie, global bss.
1849 Allocate zeroed space for it. */
1850 addr = stgCallocBytes(1, symtab_i->Value,
1851 "ocGetNames_PEi386(non-anonymous bss)");
1852 addSection(oc, SECTIONKIND_RWDATA, addr,
1853 ((UChar*)addr) + symtab_i->Value - 1);
1854 addProddableBlock(oc, addr, symtab_i->Value);
1855 /* debugBelch("BSS section at 0x%x\n", addr); */
1858 if (addr != NULL ) {
1859 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1860 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
1861 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
1862 ASSERT(i >= 0 && i < oc->n_symbols);
1863 /* cstring_from_COFF_symbol_name always succeeds. */
1864 oc->symbols[i] = sname;
1865 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1869 "IGNORING symbol %d\n"
1873 printName ( symtab_i->Name, strtab );
1882 (Int32)(symtab_i->SectionNumber),
1883 (UInt32)symtab_i->Type,
1884 (UInt32)symtab_i->StorageClass,
1885 (UInt32)symtab_i->NumberOfAuxSymbols
1890 i += symtab_i->NumberOfAuxSymbols;
1899 ocResolve_PEi386 ( ObjectCode* oc )
1902 COFF_section* sectab;
1903 COFF_symbol* symtab;
1913 /* ToDo: should be variable-sized? But is at least safe in the
1914 sense of buffer-overrun-proof. */
1916 /* debugBelch("resolving for %s\n", oc->fileName); */
1918 hdr = (COFF_header*)(oc->image);
1919 sectab = (COFF_section*) (
1920 ((UChar*)(oc->image))
1921 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1923 symtab = (COFF_symbol*) (
1924 ((UChar*)(oc->image))
1925 + hdr->PointerToSymbolTable
1927 strtab = ((UChar*)(oc->image))
1928 + hdr->PointerToSymbolTable
1929 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1931 for (i = 0; i < hdr->NumberOfSections; i++) {
1932 COFF_section* sectab_i
1934 myindex ( sizeof_COFF_section, sectab, i );
1937 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1940 /* Ignore sections called which contain stabs debugging
1942 if (0 == strcmp(".stab", sectab_i->Name)
1943 || 0 == strcmp(".stabstr", sectab_i->Name))
1946 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1947 /* If the relocation field (a short) has overflowed, the
1948 * real count can be found in the first reloc entry.
1950 * See Section 4.1 (last para) of the PE spec (rev6.0).
1952 * Nov2003 update: the GNU linker still doesn't correctly
1953 * handle the generation of relocatable object files with
1954 * overflown relocations. Hence the output to warn of potential
1957 COFF_reloc* rel = (COFF_reloc*)
1958 myindex ( sizeof_COFF_reloc, reltab, 0 );
1959 noRelocs = rel->VirtualAddress;
1960 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
1964 noRelocs = sectab_i->NumberOfRelocations;
1969 for (; j < noRelocs; j++) {
1971 COFF_reloc* reltab_j
1973 myindex ( sizeof_COFF_reloc, reltab, j );
1975 /* the location to patch */
1977 ((UChar*)(oc->image))
1978 + (sectab_i->PointerToRawData
1979 + reltab_j->VirtualAddress
1980 - sectab_i->VirtualAddress )
1982 /* the existing contents of pP */
1984 /* the symbol to connect to */
1985 sym = (COFF_symbol*)
1986 myindex ( sizeof_COFF_symbol,
1987 symtab, reltab_j->SymbolTableIndex );
1990 "reloc sec %2d num %3d: type 0x%-4x "
1991 "vaddr 0x%-8x name `",
1993 (UInt32)reltab_j->Type,
1994 reltab_j->VirtualAddress );
1995 printName ( sym->Name, strtab );
1996 debugBelch("'\n" ));
1998 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1999 COFF_section* section_sym
2000 = findPEi386SectionCalled ( oc, sym->Name );
2002 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2005 S = ((UInt32)(oc->image))
2006 + (section_sym->PointerToRawData
2009 copyName ( sym->Name, strtab, symbol, 1000-1 );
2010 (void*)S = lookupLocalSymbol( oc, symbol );
2011 if ((void*)S != NULL) goto foundit;
2012 (void*)S = lookupSymbol( symbol );
2013 if ((void*)S != NULL) goto foundit;
2014 zapTrailingAtSign ( symbol );
2015 (void*)S = lookupLocalSymbol( oc, symbol );
2016 if ((void*)S != NULL) goto foundit;
2017 (void*)S = lookupSymbol( symbol );
2018 if ((void*)S != NULL) goto foundit;
2019 /* Newline first because the interactive linker has printed "linking..." */
2020 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2024 checkProddableBlock(oc, pP);
2025 switch (reltab_j->Type) {
2026 case MYIMAGE_REL_I386_DIR32:
2029 case MYIMAGE_REL_I386_REL32:
2030 /* Tricky. We have to insert a displacement at
2031 pP which, when added to the PC for the _next_
2032 insn, gives the address of the target (S).
2033 Problem is to know the address of the next insn
2034 when we only know pP. We assume that this
2035 literal field is always the last in the insn,
2036 so that the address of the next insn is pP+4
2037 -- hence the constant 4.
2038 Also I don't know if A should be added, but so
2039 far it has always been zero.
2042 *pP = S - ((UInt32)pP) - 4;
2045 debugBelch(("%s: unhandled PEi386 relocation type %d",
2046 oc->fileName, reltab_j->Type);
2053 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2057 #endif /* defined(OBJFORMAT_PEi386) */
2060 /* --------------------------------------------------------------------------
2062 * ------------------------------------------------------------------------*/
2064 #if defined(OBJFORMAT_ELF)
2069 #if defined(sparc_TARGET_ARCH)
2070 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2071 #elif defined(i386_TARGET_ARCH)
2072 # define ELF_TARGET_386 /* Used inside <elf.h> */
2073 #elif defined(x86_64_TARGET_ARCH)
2074 # define ELF_TARGET_X64_64
2076 #elif defined (ia64_TARGET_ARCH)
2077 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2079 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2080 # define ELF_NEED_GOT /* needs Global Offset Table */
2081 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2084 #if !defined(openbsd_TARGET_OS)
2087 /* openbsd elf has things in different places, with diff names */
2088 #include <elf_abi.h>
2089 #include <machine/reloc.h>
2090 #define R_386_32 RELOC_32
2091 #define R_386_PC32 RELOC_PC32
2095 * Define a set of types which can be used for both ELF32 and ELF64
2099 #define ELFCLASS ELFCLASS64
2100 #define Elf_Addr Elf64_Addr
2101 #define Elf_Word Elf64_Word
2102 #define Elf_Sword Elf64_Sword
2103 #define Elf_Ehdr Elf64_Ehdr
2104 #define Elf_Phdr Elf64_Phdr
2105 #define Elf_Shdr Elf64_Shdr
2106 #define Elf_Sym Elf64_Sym
2107 #define Elf_Rel Elf64_Rel
2108 #define Elf_Rela Elf64_Rela
2109 #define ELF_ST_TYPE ELF64_ST_TYPE
2110 #define ELF_ST_BIND ELF64_ST_BIND
2111 #define ELF_R_TYPE ELF64_R_TYPE
2112 #define ELF_R_SYM ELF64_R_SYM
2114 #define ELFCLASS ELFCLASS32
2115 #define Elf_Addr Elf32_Addr
2116 #define Elf_Word Elf32_Word
2117 #define Elf_Sword Elf32_Sword
2118 #define Elf_Ehdr Elf32_Ehdr
2119 #define Elf_Phdr Elf32_Phdr
2120 #define Elf_Shdr Elf32_Shdr
2121 #define Elf_Sym Elf32_Sym
2122 #define Elf_Rel Elf32_Rel
2123 #define Elf_Rela Elf32_Rela
2125 #define ELF_ST_TYPE ELF32_ST_TYPE
2128 #define ELF_ST_BIND ELF32_ST_BIND
2131 #define ELF_R_TYPE ELF32_R_TYPE
2134 #define ELF_R_SYM ELF32_R_SYM
2140 * Functions to allocate entries in dynamic sections. Currently we simply
2141 * preallocate a large number, and we don't check if a entry for the given
2142 * target already exists (a linear search is too slow). Ideally these
2143 * entries would be associated with symbols.
2146 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2147 #define GOT_SIZE 0x20000
2148 #define FUNCTION_TABLE_SIZE 0x10000
2149 #define PLT_SIZE 0x08000
2152 static Elf_Addr got[GOT_SIZE];
2153 static unsigned int gotIndex;
2154 static Elf_Addr gp_val = (Elf_Addr)got;
2157 allocateGOTEntry(Elf_Addr target)
2161 if (gotIndex >= GOT_SIZE)
2162 barf("Global offset table overflow");
2164 entry = &got[gotIndex++];
2166 return (Elf_Addr)entry;
2170 #ifdef ELF_FUNCTION_DESC
2176 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2177 static unsigned int functionTableIndex;
2180 allocateFunctionDesc(Elf_Addr target)
2182 FunctionDesc *entry;
2184 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2185 barf("Function table overflow");
2187 entry = &functionTable[functionTableIndex++];
2189 entry->gp = (Elf_Addr)gp_val;
2190 return (Elf_Addr)entry;
2194 copyFunctionDesc(Elf_Addr target)
2196 FunctionDesc *olddesc = (FunctionDesc *)target;
2197 FunctionDesc *newdesc;
2199 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2200 newdesc->gp = olddesc->gp;
2201 return (Elf_Addr)newdesc;
2206 #ifdef ia64_TARGET_ARCH
2207 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2208 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2210 static unsigned char plt_code[] =
2212 /* taken from binutils bfd/elfxx-ia64.c */
2213 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2214 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2215 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2216 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2217 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2218 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2221 /* If we can't get to the function descriptor via gp, take a local copy of it */
2222 #define PLT_RELOC(code, target) { \
2223 Elf64_Sxword rel_value = target - gp_val; \
2224 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2225 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2227 ia64_reloc_gprel22((Elf_Addr)code, target); \
2232 unsigned char code[sizeof(plt_code)];
2236 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2238 PLTEntry *plt = (PLTEntry *)oc->plt;
2241 if (oc->pltIndex >= PLT_SIZE)
2242 barf("Procedure table overflow");
2244 entry = &plt[oc->pltIndex++];
2245 memcpy(entry->code, plt_code, sizeof(entry->code));
2246 PLT_RELOC(entry->code, target);
2247 return (Elf_Addr)entry;
2253 return (PLT_SIZE * sizeof(PLTEntry));
2259 * Generic ELF functions
2263 findElfSection ( void* objImage, Elf_Word sh_type )
2265 char* ehdrC = (char*)objImage;
2266 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2267 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2268 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2272 for (i = 0; i < ehdr->e_shnum; i++) {
2273 if (shdr[i].sh_type == sh_type
2274 /* Ignore the section header's string table. */
2275 && i != ehdr->e_shstrndx
2276 /* Ignore string tables named .stabstr, as they contain
2278 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2280 ptr = ehdrC + shdr[i].sh_offset;
2287 #if defined(ia64_TARGET_ARCH)
2289 findElfSegment ( void* objImage, Elf_Addr vaddr )
2291 char* ehdrC = (char*)objImage;
2292 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2293 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2294 Elf_Addr segaddr = 0;
2297 for (i = 0; i < ehdr->e_phnum; i++) {
2298 segaddr = phdr[i].p_vaddr;
2299 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2307 ocVerifyImage_ELF ( ObjectCode* oc )
2311 int i, j, nent, nstrtab, nsymtabs;
2315 char* ehdrC = (char*)(oc->image);
2316 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2318 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2319 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2320 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2321 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2322 errorBelch("%s: not an ELF object", oc->fileName);
2326 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2327 errorBelch("%s: unsupported ELF format", oc->fileName);
2331 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2332 IF_DEBUG(linker,debugBelch( "Is little-endian" ));
2334 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2335 IF_DEBUG(linker,debugBelch( "Is big-endian" ));
2337 errorBelch("%s: unknown endiannness", oc->fileName);
2341 if (ehdr->e_type != ET_REL) {
2342 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2345 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file" ));
2347 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2348 switch (ehdr->e_machine) {
2349 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2350 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2352 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2354 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2355 errorBelch("%s: unknown architecture", oc->fileName);
2359 IF_DEBUG(linker,debugBelch(
2360 "\nSection header table: start %d, n_entries %d, ent_size %d",
2361 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2363 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2365 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2367 if (ehdr->e_shstrndx == SHN_UNDEF) {
2368 errorBelch("%s: no section header string table", oc->fileName);
2371 IF_DEBUG(linker,debugBelch( "Section header string table is section %d",
2373 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2376 for (i = 0; i < ehdr->e_shnum; i++) {
2377 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2378 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2379 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2380 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2381 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2382 ehdrC + shdr[i].sh_offset,
2383 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2385 if (shdr[i].sh_type == SHT_REL) {
2386 IF_DEBUG(linker,debugBelch("Rel " ));
2387 } else if (shdr[i].sh_type == SHT_RELA) {
2388 IF_DEBUG(linker,debugBelch("RelA " ));
2390 IF_DEBUG(linker,debugBelch(" "));
2393 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2397 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2400 for (i = 0; i < ehdr->e_shnum; i++) {
2401 if (shdr[i].sh_type == SHT_STRTAB
2402 /* Ignore the section header's string table. */
2403 && i != ehdr->e_shstrndx
2404 /* Ignore string tables named .stabstr, as they contain
2406 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2408 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2409 strtab = ehdrC + shdr[i].sh_offset;
2414 errorBelch("%s: no string tables, or too many", oc->fileName);
2419 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2420 for (i = 0; i < ehdr->e_shnum; i++) {
2421 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2422 IF_DEBUG(linker,debugBelch( "section %d is a symbol table", i ));
2424 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2425 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2426 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)",
2428 shdr[i].sh_size % sizeof(Elf_Sym)
2430 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2431 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2434 for (j = 0; j < nent; j++) {
2435 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2436 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2437 (int)stab[j].st_shndx,
2438 (int)stab[j].st_size,
2439 (char*)stab[j].st_value ));
2441 IF_DEBUG(linker,debugBelch("type=" ));
2442 switch (ELF_ST_TYPE(stab[j].st_info)) {
2443 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2444 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2445 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2446 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2447 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2448 default: IF_DEBUG(linker,debugBelch("? " )); break;
2450 IF_DEBUG(linker,debugBelch(" " ));
2452 IF_DEBUG(linker,debugBelch("bind=" ));
2453 switch (ELF_ST_BIND(stab[j].st_info)) {
2454 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2455 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2456 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2457 default: IF_DEBUG(linker,debugBelch("? " )); break;
2459 IF_DEBUG(linker,debugBelch(" " ));
2461 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2465 if (nsymtabs == 0) {
2466 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2475 ocGetNames_ELF ( ObjectCode* oc )
2480 char* ehdrC = (char*)(oc->image);
2481 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2482 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2483 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2485 ASSERT(symhash != NULL);
2488 errorBelch("%s: no strtab", oc->fileName);
2493 for (i = 0; i < ehdr->e_shnum; i++) {
2494 /* Figure out what kind of section it is. Logic derived from
2495 Figure 1.14 ("Special Sections") of the ELF document
2496 ("Portable Formats Specification, Version 1.1"). */
2497 Elf_Shdr hdr = shdr[i];
2498 SectionKind kind = SECTIONKIND_OTHER;
2501 if (hdr.sh_type == SHT_PROGBITS
2502 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2503 /* .text-style section */
2504 kind = SECTIONKIND_CODE_OR_RODATA;
2507 if (hdr.sh_type == SHT_PROGBITS
2508 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2509 /* .data-style section */
2510 kind = SECTIONKIND_RWDATA;
2513 if (hdr.sh_type == SHT_PROGBITS
2514 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2515 /* .rodata-style section */
2516 kind = SECTIONKIND_CODE_OR_RODATA;
2519 if (hdr.sh_type == SHT_NOBITS
2520 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2521 /* .bss-style section */
2522 kind = SECTIONKIND_RWDATA;
2526 if (is_bss && shdr[i].sh_size > 0) {
2527 /* This is a non-empty .bss section. Allocate zeroed space for
2528 it, and set its .sh_offset field such that
2529 ehdrC + .sh_offset == addr_of_zeroed_space. */
2530 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2531 "ocGetNames_ELF(BSS)");
2532 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2534 debugBelch("BSS section at 0x%x, size %d\n",
2535 zspace, shdr[i].sh_size);
2539 /* fill in the section info */
2540 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2541 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2542 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2543 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2546 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2548 /* copy stuff into this module's object symbol table */
2549 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2550 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2552 oc->n_symbols = nent;
2553 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2554 "ocGetNames_ELF(oc->symbols)");
2556 for (j = 0; j < nent; j++) {
2558 char isLocal = FALSE; /* avoids uninit-var warning */
2560 char* nm = strtab + stab[j].st_name;
2561 int secno = stab[j].st_shndx;
2563 /* Figure out if we want to add it; if so, set ad to its
2564 address. Otherwise leave ad == NULL. */
2566 if (secno == SHN_COMMON) {
2568 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2570 debugBelch("COMMON symbol, size %d name %s\n",
2571 stab[j].st_size, nm);
2573 /* Pointless to do addProddableBlock() for this area,
2574 since the linker should never poke around in it. */
2577 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2578 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2580 /* and not an undefined symbol */
2581 && stab[j].st_shndx != SHN_UNDEF
2582 /* and not in a "special section" */
2583 && stab[j].st_shndx < SHN_LORESERVE
2585 /* and it's a not a section or string table or anything silly */
2586 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2587 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2588 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2591 /* Section 0 is the undefined section, hence > and not >=. */
2592 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2594 if (shdr[secno].sh_type == SHT_NOBITS) {
2595 debugBelch(" BSS symbol, size %d off %d name %s\n",
2596 stab[j].st_size, stab[j].st_value, nm);
2599 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2600 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2603 #ifdef ELF_FUNCTION_DESC
2604 /* dlsym() and the initialisation table both give us function
2605 * descriptors, so to be consistent we store function descriptors
2606 * in the symbol table */
2607 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2608 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2610 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
2611 ad, oc->fileName, nm ));
2616 /* And the decision is ... */
2620 oc->symbols[j] = nm;
2623 /* Ignore entirely. */
2625 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2629 IF_DEBUG(linker,debugBelch( "skipping `%s'",
2630 strtab + stab[j].st_name ));
2633 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2634 (int)ELF_ST_BIND(stab[j].st_info),
2635 (int)ELF_ST_TYPE(stab[j].st_info),
2636 (int)stab[j].st_shndx,
2637 strtab + stab[j].st_name
2640 oc->symbols[j] = NULL;
2649 /* Do ELF relocations which lack an explicit addend. All x86-linux
2650 relocations appear to be of this form. */
2652 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2653 Elf_Shdr* shdr, int shnum,
2654 Elf_Sym* stab, char* strtab )
2659 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2660 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2661 int target_shndx = shdr[shnum].sh_info;
2662 int symtab_shndx = shdr[shnum].sh_link;
2664 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2665 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2666 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d",
2667 target_shndx, symtab_shndx ));
2669 for (j = 0; j < nent; j++) {
2670 Elf_Addr offset = rtab[j].r_offset;
2671 Elf_Addr info = rtab[j].r_info;
2673 Elf_Addr P = ((Elf_Addr)targ) + offset;
2674 Elf_Word* pP = (Elf_Word*)P;
2680 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
2681 j, (void*)offset, (void*)info ));
2683 IF_DEBUG(linker,debugBelch( " ZERO" ));
2686 Elf_Sym sym = stab[ELF_R_SYM(info)];
2687 /* First see if it is a local symbol. */
2688 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2689 /* Yes, so we can get the address directly from the ELF symbol
2691 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2693 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2694 + stab[ELF_R_SYM(info)].st_value);
2697 /* No, so look up the name in our global table. */
2698 symbol = strtab + sym.st_name;
2699 S_tmp = lookupSymbol( symbol );
2700 S = (Elf_Addr)S_tmp;
2703 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2706 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
2709 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p",
2710 (void*)P, (void*)S, (void*)A ));
2711 checkProddableBlock ( oc, pP );
2715 switch (ELF_R_TYPE(info)) {
2716 # ifdef i386_TARGET_ARCH
2717 case R_386_32: *pP = value; break;
2718 case R_386_PC32: *pP = value - P; break;
2721 errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
2722 oc->fileName, ELF_R_TYPE(info));
2730 /* Do ELF relocations for which explicit addends are supplied.
2731 sparc-solaris relocations appear to be of this form. */
2733 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2734 Elf_Shdr* shdr, int shnum,
2735 Elf_Sym* stab, char* strtab )
2740 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2741 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2742 int target_shndx = shdr[shnum].sh_info;
2743 int symtab_shndx = shdr[shnum].sh_link;
2745 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2746 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2747 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d",
2748 target_shndx, symtab_shndx ));
2750 for (j = 0; j < nent; j++) {
2751 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2752 /* This #ifdef only serves to avoid unused-var warnings. */
2753 Elf_Addr offset = rtab[j].r_offset;
2754 Elf_Addr P = targ + offset;
2756 Elf_Addr info = rtab[j].r_info;
2757 Elf_Addr A = rtab[j].r_addend;
2761 # if defined(sparc_TARGET_ARCH)
2762 Elf_Word* pP = (Elf_Word*)P;
2764 # elif defined(ia64_TARGET_ARCH)
2765 Elf64_Xword *pP = (Elf64_Xword *)P;
2769 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
2770 j, (void*)offset, (void*)info,
2773 IF_DEBUG(linker,debugBelch( " ZERO" ));
2776 Elf_Sym sym = stab[ELF_R_SYM(info)];
2777 /* First see if it is a local symbol. */
2778 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2779 /* Yes, so we can get the address directly from the ELF symbol
2781 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2783 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2784 + stab[ELF_R_SYM(info)].st_value);
2785 #ifdef ELF_FUNCTION_DESC
2786 /* Make a function descriptor for this function */
2787 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2788 S = allocateFunctionDesc(S + A);
2793 /* No, so look up the name in our global table. */
2794 symbol = strtab + sym.st_name;
2795 S_tmp = lookupSymbol( symbol );
2796 S = (Elf_Addr)S_tmp;
2798 #ifdef ELF_FUNCTION_DESC
2799 /* If a function, already a function descriptor - we would
2800 have to copy it to add an offset. */
2801 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2802 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2806 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2809 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
2812 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
2813 (void*)P, (void*)S, (void*)A ));
2814 /* checkProddableBlock ( oc, (void*)P ); */
2818 switch (ELF_R_TYPE(info)) {
2819 # if defined(sparc_TARGET_ARCH)
2820 case R_SPARC_WDISP30:
2821 w1 = *pP & 0xC0000000;
2822 w2 = (Elf_Word)((value - P) >> 2);
2823 ASSERT((w2 & 0xC0000000) == 0);
2828 w1 = *pP & 0xFFC00000;
2829 w2 = (Elf_Word)(value >> 10);
2830 ASSERT((w2 & 0xFFC00000) == 0);
2836 w2 = (Elf_Word)(value & 0x3FF);
2837 ASSERT((w2 & ~0x3FF) == 0);
2841 /* According to the Sun documentation:
2843 This relocation type resembles R_SPARC_32, except it refers to an
2844 unaligned word. That is, the word to be relocated must be treated
2845 as four separate bytes with arbitrary alignment, not as a word
2846 aligned according to the architecture requirements.
2848 (JRS: which means that freeloading on the R_SPARC_32 case
2849 is probably wrong, but hey ...)
2853 w2 = (Elf_Word)value;
2856 # elif defined(ia64_TARGET_ARCH)
2857 case R_IA64_DIR64LSB:
2858 case R_IA64_FPTR64LSB:
2861 case R_IA64_PCREL64LSB:
2864 case R_IA64_SEGREL64LSB:
2865 addr = findElfSegment(ehdrC, value);
2868 case R_IA64_GPREL22:
2869 ia64_reloc_gprel22(P, value);
2871 case R_IA64_LTOFF22:
2872 case R_IA64_LTOFF22X:
2873 case R_IA64_LTOFF_FPTR22:
2874 addr = allocateGOTEntry(value);
2875 ia64_reloc_gprel22(P, addr);
2877 case R_IA64_PCREL21B:
2878 ia64_reloc_pcrel21(P, S, oc);
2881 /* This goes with R_IA64_LTOFF22X and points to the load to
2882 * convert into a move. We don't implement relaxation. */
2886 errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
2887 oc->fileName, ELF_R_TYPE(info));
2896 ocResolve_ELF ( ObjectCode* oc )
2900 Elf_Sym* stab = NULL;
2901 char* ehdrC = (char*)(oc->image);
2902 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2903 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2904 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2906 /* first find "the" symbol table */
2907 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2909 /* also go find the string table */
2910 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2912 if (stab == NULL || strtab == NULL) {
2913 errorBelch("%s: can't find string or symbol table", oc->fileName);
2917 /* Process the relocation sections. */
2918 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2920 /* Skip sections called ".rel.stab". These appear to contain
2921 relocation entries that, when done, make the stabs debugging
2922 info point at the right places. We ain't interested in all
2924 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2927 if (shdr[shnum].sh_type == SHT_REL ) {
2928 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2929 shnum, stab, strtab );
2933 if (shdr[shnum].sh_type == SHT_RELA) {
2934 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2935 shnum, stab, strtab );
2940 /* Free the local symbol table; we won't need it again. */
2941 freeHashTable(oc->lochash, NULL);
2949 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2950 * at the front. The following utility functions pack and unpack instructions, and
2951 * take care of the most common relocations.
2954 #ifdef ia64_TARGET_ARCH
2957 ia64_extract_instruction(Elf64_Xword *target)
2960 int slot = (Elf_Addr)target & 3;
2961 (Elf_Addr)target &= ~3;
2969 return ((w1 >> 5) & 0x1ffffffffff);
2971 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2975 barf("ia64_extract_instruction: invalid slot %p", target);
2980 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2982 int slot = (Elf_Addr)target & 3;
2983 (Elf_Addr)target &= ~3;
2988 *target |= value << 5;
2991 *target |= value << 46;
2992 *(target+1) |= value >> 18;
2995 *(target+1) |= value << 23;
3001 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3003 Elf64_Xword instruction;
3004 Elf64_Sxword rel_value;
3006 rel_value = value - gp_val;
3007 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3008 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3010 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3011 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3012 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3013 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3014 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3015 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3019 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3021 Elf64_Xword instruction;
3022 Elf64_Sxword rel_value;
3025 entry = allocatePLTEntry(value, oc);
3027 rel_value = (entry >> 4) - (target >> 4);
3028 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3029 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3031 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3032 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3033 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3034 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3041 /* --------------------------------------------------------------------------
3043 * ------------------------------------------------------------------------*/
3045 #if defined(OBJFORMAT_MACHO)
3048 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3049 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3051 I hereby formally apologize for the hackish nature of this code.
3052 Things that need to be done:
3053 *) implement ocVerifyImage_MachO
3054 *) add still more sanity checks.
3059 ocAllocateJumpIslands_MachO
3061 Allocate additional space at the end of the object file image to make room
3064 PowerPC relative branch instructions have a 24 bit displacement field.
3065 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
3066 If a particular imported symbol is outside this range, we have to redirect
3067 the jump to a short piece of new code that just loads the 32bit absolute
3068 address and jumps there.
3069 This function just allocates space for one 16 byte jump island for every
3070 undefined symbol in the object file. The code for the islands is filled in by
3071 makeJumpIsland below.
3074 static const int islandSize = 16;
3076 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3078 char *image = (char*) oc->image;
3079 struct mach_header *header = (struct mach_header*) image;
3080 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3083 for(i=0;i<header->ncmds;i++)
3085 if(lc->cmd == LC_DYSYMTAB)
3087 struct dysymtab_command *dsymLC = (struct dysymtab_command*) lc;
3088 unsigned long nundefsym = dsymLC->nundefsym;
3089 oc->island_start_symbol = dsymLC->iundefsym;
3090 oc->n_islands = nundefsym;
3095 #error ocAllocateJumpIslands_MachO doesnt want USE_MMAP to be defined
3097 oc->image = stgReallocBytes(
3098 image, oc->fileSize + islandSize * nundefsym,
3099 "ocAllocateJumpIslands_MachO");
3101 oc->jump_islands = oc->image + oc->fileSize;
3102 memset(oc->jump_islands, 0, islandSize * nundefsym);
3105 break; // there can be only one LC_DSYMTAB
3107 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3112 static int ocVerifyImage_MachO(ObjectCode* oc)
3114 // FIXME: do some verifying here
3118 static int resolveImports(
3121 struct symtab_command *symLC,
3122 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3123 unsigned long *indirectSyms,
3124 struct nlist *nlist)
3128 for(i=0;i*4<sect->size;i++)
3130 // according to otool, reserved1 contains the first index into the indirect symbol table
3131 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3132 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3135 if((symbol->n_type & N_TYPE) == N_UNDF
3136 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3137 addr = (void*) (symbol->n_value);
3138 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3141 addr = lookupSymbol(nm);
3144 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3148 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3149 ((void**)(image + sect->offset))[i] = addr;
3155 static void* makeJumpIsland(
3157 unsigned long symbolNumber,
3160 if(symbolNumber < oc->island_start_symbol ||
3161 symbolNumber - oc->island_start_symbol > oc->n_islands)
3163 symbolNumber -= oc->island_start_symbol;
3165 void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber);
3166 unsigned long *p = (unsigned long*) island;
3168 // lis r12, hi16(target)
3169 *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 );
3170 // ori r12, r12, lo16(target)
3171 *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF );
3177 return (void*) island;
3180 static char* relocateAddress(
3183 struct section* sections,
3184 unsigned long address)
3187 for(i = 0; i < nSections; i++)
3189 if(sections[i].addr <= address
3190 && address < sections[i].addr + sections[i].size)
3192 return oc->image + sections[i].offset + address - sections[i].addr;
3195 barf("Invalid Mach-O file:"
3196 "Address out of bounds while relocating object file");
3200 static int relocateSection(
3203 struct symtab_command *symLC, struct nlist *nlist,
3204 int nSections, struct section* sections, struct section *sect)
3206 struct relocation_info *relocs;
3209 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3211 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3215 relocs = (struct relocation_info*) (image + sect->reloff);
3219 if(relocs[i].r_address & R_SCATTERED)
3221 struct scattered_relocation_info *scat =
3222 (struct scattered_relocation_info*) &relocs[i];
3226 if(scat->r_length == 2)
3228 unsigned long word = 0;
3229 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3230 checkProddableBlock(oc,wordPtr);
3232 // Step 1: Figure out what the relocated value should be
3233 if(scat->r_type == GENERIC_RELOC_VANILLA)
3235 word = scat->r_value + sect->offset + ((long) image);
3237 else if(scat->r_type == PPC_RELOC_SECTDIFF
3238 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3239 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3240 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3242 struct scattered_relocation_info *pair =
3243 (struct scattered_relocation_info*) &relocs[i+1];
3245 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3246 barf("Invalid Mach-O file: "
3247 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3249 word = (unsigned long)
3250 (relocateAddress(oc, nSections, sections, scat->r_value)
3251 - relocateAddress(oc, nSections, sections, pair->r_value));
3254 else if(scat->r_type == PPC_RELOC_HI16
3255 || scat->r_type == PPC_RELOC_LO16
3256 || scat->r_type == PPC_RELOC_HA16
3257 || scat->r_type == PPC_RELOC_LO14)
3258 { // these are generated by label+offset things
3259 struct relocation_info *pair = &relocs[i+1];
3260 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3261 barf("Invalid Mach-O file: "
3262 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3264 if(scat->r_type == PPC_RELOC_LO16)
3266 word = ((unsigned short*) wordPtr)[1];
3267 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3269 else if(scat->r_type == PPC_RELOC_LO14)
3271 barf("Unsupported Relocation: PPC_RELOC_LO14");
3272 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3273 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3275 else if(scat->r_type == PPC_RELOC_HI16)
3277 word = ((unsigned short*) wordPtr)[1] << 16;
3278 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3280 else if(scat->r_type == PPC_RELOC_HA16)
3282 word = ((unsigned short*) wordPtr)[1] << 16;
3283 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3287 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3293 continue; // ignore the others
3295 if(scat->r_type == GENERIC_RELOC_VANILLA
3296 || scat->r_type == PPC_RELOC_SECTDIFF)
3300 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3302 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3304 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3306 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3308 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3310 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3311 + ((word & (1<<15)) ? 1 : 0);
3316 continue; // FIXME: I hope it's OK to ignore all the others.
3320 struct relocation_info *reloc = &relocs[i];
3321 if(reloc->r_pcrel && !reloc->r_extern)
3324 if(reloc->r_length == 2)
3326 unsigned long word = 0;
3327 unsigned long jumpIsland = 0;
3328 long offsetToJumpIsland;
3330 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3331 checkProddableBlock(oc,wordPtr);
3333 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3337 else if(reloc->r_type == PPC_RELOC_LO16)
3339 word = ((unsigned short*) wordPtr)[1];
3340 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3342 else if(reloc->r_type == PPC_RELOC_HI16)
3344 word = ((unsigned short*) wordPtr)[1] << 16;
3345 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3347 else if(reloc->r_type == PPC_RELOC_HA16)
3349 word = ((unsigned short*) wordPtr)[1] << 16;
3350 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3352 else if(reloc->r_type == PPC_RELOC_BR24)
3355 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3359 if(!reloc->r_extern)
3362 sections[reloc->r_symbolnum-1].offset
3363 - sections[reloc->r_symbolnum-1].addr
3370 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3371 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3372 unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
3375 errorBelch("\nunknown symbol `%s'", nm);
3382 word = symbolAddress;
3383 jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
3384 word -= ((long)image) + sect->offset + reloc->r_address;
3387 offsetToJumpIsland = jumpIsland
3388 - (((long)image) + sect->offset + reloc->r_address);
3393 word += symbolAddress;
3397 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3402 else if(reloc->r_type == PPC_RELOC_LO16)
3404 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3407 else if(reloc->r_type == PPC_RELOC_HI16)
3409 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3412 else if(reloc->r_type == PPC_RELOC_HA16)
3414 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3415 + ((word & (1<<15)) ? 1 : 0);
3418 else if(reloc->r_type == PPC_RELOC_BR24)
3420 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3422 // The branch offset is too large.
3423 // Therefore, we try to use a jump island.
3425 barf("unconditional relative branch out of range: "
3426 "no jump island available");
3428 word = offsetToJumpIsland;
3429 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3430 barf("unconditional relative branch out of range: "
3431 "jump island out of range");
3433 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3437 barf("\nunknown relocation %d",reloc->r_type);
3444 static int ocGetNames_MachO(ObjectCode* oc)
3446 char *image = (char*) oc->image;
3447 struct mach_header *header = (struct mach_header*) image;
3448 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3449 unsigned i,curSymbol;
3450 struct segment_command *segLC = NULL;
3451 struct section *sections;
3452 struct symtab_command *symLC = NULL;
3453 struct dysymtab_command *dsymLC = NULL;
3454 struct nlist *nlist;
3455 unsigned long commonSize = 0;
3456 char *commonStorage = NULL;
3457 unsigned long commonCounter;
3459 for(i=0;i<header->ncmds;i++)
3461 if(lc->cmd == LC_SEGMENT)
3462 segLC = (struct segment_command*) lc;
3463 else if(lc->cmd == LC_SYMTAB)
3464 symLC = (struct symtab_command*) lc;
3465 else if(lc->cmd == LC_DYSYMTAB)
3466 dsymLC = (struct dysymtab_command*) lc;
3467 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3470 sections = (struct section*) (segLC+1);
3471 nlist = (struct nlist*) (image + symLC->symoff);
3473 for(i=0;i<segLC->nsects;i++)
3475 if(sections[i].size == 0)
3478 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3480 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3481 "ocGetNames_MachO(common symbols)");
3482 sections[i].offset = zeroFillArea - image;
3485 if(!strcmp(sections[i].sectname,"__text"))
3486 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3487 (void*) (image + sections[i].offset),
3488 (void*) (image + sections[i].offset + sections[i].size));
3489 else if(!strcmp(sections[i].sectname,"__const"))
3490 addSection(oc, SECTIONKIND_RWDATA,
3491 (void*) (image + sections[i].offset),
3492 (void*) (image + sections[i].offset + sections[i].size));
3493 else if(!strcmp(sections[i].sectname,"__data"))
3494 addSection(oc, SECTIONKIND_RWDATA,
3495 (void*) (image + sections[i].offset),
3496 (void*) (image + sections[i].offset + sections[i].size));
3497 else if(!strcmp(sections[i].sectname,"__bss")
3498 || !strcmp(sections[i].sectname,"__common"))
3499 addSection(oc, SECTIONKIND_RWDATA,
3500 (void*) (image + sections[i].offset),
3501 (void*) (image + sections[i].offset + sections[i].size));
3503 addProddableBlock(oc, (void*) (image + sections[i].offset),
3507 // count external symbols defined here
3509 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3511 if((nlist[i].n_type & N_TYPE) == N_SECT)
3514 for(i=0;i<symLC->nsyms;i++)
3516 if((nlist[i].n_type & N_TYPE) == N_UNDF
3517 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3519 commonSize += nlist[i].n_value;
3523 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3524 "ocGetNames_MachO(oc->symbols)");
3526 // insert symbols into hash table
3527 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3529 if((nlist[i].n_type & N_TYPE) == N_SECT)
3531 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3532 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3533 sections[nlist[i].n_sect-1].offset
3534 - sections[nlist[i].n_sect-1].addr
3535 + nlist[i].n_value);
3536 oc->symbols[curSymbol++] = nm;
3540 // insert local symbols into lochash
3541 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3543 if((nlist[i].n_type & N_TYPE) == N_SECT)
3545 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3546 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3547 sections[nlist[i].n_sect-1].offset
3548 - sections[nlist[i].n_sect-1].addr
3549 + nlist[i].n_value);
3554 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3555 commonCounter = (unsigned long)commonStorage;
3556 for(i=0;i<symLC->nsyms;i++)
3558 if((nlist[i].n_type & N_TYPE) == N_UNDF
3559 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3561 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3562 unsigned long sz = nlist[i].n_value;
3564 nlist[i].n_value = commonCounter;
3566 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3567 oc->symbols[curSymbol++] = nm;
3569 commonCounter += sz;
3575 static int ocResolve_MachO(ObjectCode* oc)
3577 char *image = (char*) oc->image;
3578 struct mach_header *header = (struct mach_header*) image;
3579 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3581 struct segment_command *segLC = NULL;
3582 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3583 struct symtab_command *symLC = NULL;
3584 struct dysymtab_command *dsymLC = NULL;
3585 struct nlist *nlist;
3586 unsigned long *indirectSyms;
3588 for(i=0;i<header->ncmds;i++)
3590 if(lc->cmd == LC_SEGMENT)
3591 segLC = (struct segment_command*) lc;
3592 else if(lc->cmd == LC_SYMTAB)
3593 symLC = (struct symtab_command*) lc;
3594 else if(lc->cmd == LC_DYSYMTAB)
3595 dsymLC = (struct dysymtab_command*) lc;
3596 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3599 sections = (struct section*) (segLC+1);
3600 nlist = (struct nlist*) (image + symLC->symoff);
3602 for(i=0;i<segLC->nsects;i++)
3604 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3605 la_ptrs = §ions[i];
3606 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3607 nl_ptrs = §ions[i];
3610 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3613 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3616 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3619 for(i=0;i<segLC->nsects;i++)
3621 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3625 /* Free the local symbol table; we won't need it again. */
3626 freeHashTable(oc->lochash, NULL);
3630 Flush the data & instruction caches.
3631 Because the PPC has split data/instruction caches, we have to
3632 do that whenever we modify code at runtime.
3635 int n = (oc->fileSize + islandSize * oc->n_islands) / 4;
3636 unsigned long *p = (unsigned long*)oc->image;
3639 __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
3643 __asm__ volatile ("sync\n\tisync");
3649 * The Mach-O object format uses leading underscores. But not everywhere.
3650 * There is a small number of runtime support functions defined in
3651 * libcc_dynamic.a whose name does not have a leading underscore.
3652 * As a consequence, we can't get their address from C code.
3653 * We have to use inline assembler just to take the address of a function.
3657 static void machoInitSymbolsWithoutUnderscore()
3663 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3664 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3666 RTS_MACHO_NOUNDERLINE_SYMBOLS