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> and
14 MREMAP_MAYMOVE from <sys/mman.h>.
25 #include "LinkerInternals.h"
30 #ifdef HAVE_SYS_TYPES_H
31 #include <sys/types.h>
37 #ifdef HAVE_SYS_STAT_H
41 #if defined(HAVE_DLFCN_H)
45 #if defined(cygwin32_HOST_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_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
66 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
74 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
75 # define OBJFORMAT_ELF
76 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
77 # define OBJFORMAT_PEi386
80 #elif defined(darwin_HOST_OS)
81 # define OBJFORMAT_MACHO
82 # include <mach-o/loader.h>
83 # include <mach-o/nlist.h>
84 # include <mach-o/reloc.h>
85 # include <mach-o/dyld.h>
86 #if defined(powerpc_HOST_ARCH)
87 # include <mach-o/ppc/reloc.h>
91 /* Hash table mapping symbol names to Symbol */
92 static /*Str*/HashTable *symhash;
94 /* List of currently loaded objects */
95 ObjectCode *objects = NULL; /* initially empty */
97 #if defined(OBJFORMAT_ELF)
98 static int ocVerifyImage_ELF ( ObjectCode* oc );
99 static int ocGetNames_ELF ( ObjectCode* oc );
100 static int ocResolve_ELF ( ObjectCode* oc );
101 #if defined(powerpc_HOST_ARCH)
102 static int ocAllocateJumpIslands_ELF ( ObjectCode* oc );
104 #elif defined(OBJFORMAT_PEi386)
105 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
106 static int ocGetNames_PEi386 ( ObjectCode* oc );
107 static int ocResolve_PEi386 ( ObjectCode* oc );
108 #elif defined(OBJFORMAT_MACHO)
109 static int ocVerifyImage_MachO ( ObjectCode* oc );
110 static int ocGetNames_MachO ( ObjectCode* oc );
111 static int ocResolve_MachO ( ObjectCode* oc );
113 static int machoGetMisalignment( FILE * );
114 #ifdef powerpc_HOST_ARCH
115 static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
116 static void machoInitSymbolsWithoutUnderscore( void );
120 #if defined(x86_64_HOST_ARCH)
121 static void*x86_64_high_symbol( char *lbl, void *addr );
124 /* -----------------------------------------------------------------------------
125 * Built-in symbols from the RTS
128 typedef struct _RtsSymbolVal {
135 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
137 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
138 SymX(makeStableNamezh_fast) \
139 SymX(finalizzeWeakzh_fast)
141 /* These are not available in GUM!!! -- HWL */
142 #define Maybe_ForeignObj
143 #define Maybe_Stable_Names
146 #if !defined (mingw32_HOST_OS)
147 #define RTS_POSIX_ONLY_SYMBOLS \
148 SymX(stg_sig_install) \
152 #if defined (cygwin32_HOST_OS)
153 #define RTS_MINGW_ONLY_SYMBOLS /**/
154 /* Don't have the ability to read import libs / archives, so
155 * we have to stupidly list a lot of what libcygwin.a
158 #define RTS_CYGWIN_ONLY_SYMBOLS \
236 #elif !defined(mingw32_HOST_OS)
237 #define RTS_MINGW_ONLY_SYMBOLS /**/
238 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
239 #else /* defined(mingw32_HOST_OS) */
240 #define RTS_POSIX_ONLY_SYMBOLS /**/
241 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
243 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
245 #define RTS_MINGW_EXTRA_SYMS \
246 Sym(_imp____mb_cur_max) \
249 #define RTS_MINGW_EXTRA_SYMS
252 /* These are statically linked from the mingw libraries into the ghc
253 executable, so we have to employ this hack. */
254 #define RTS_MINGW_ONLY_SYMBOLS \
255 SymX(asyncReadzh_fast) \
256 SymX(asyncWritezh_fast) \
257 SymX(asyncDoProczh_fast) \
269 SymX(getservbyname) \
270 SymX(getservbyport) \
271 SymX(getprotobynumber) \
272 SymX(getprotobyname) \
273 SymX(gethostbyname) \
274 SymX(gethostbyaddr) \
308 SymX(rts_InstallConsoleEvent) \
309 SymX(rts_ConsoleHandlerDone) \
311 Sym(_imp___timezone) \
320 RTS_MINGW_EXTRA_SYMS \
324 #if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
325 #define RTS_DARWIN_ONLY_SYMBOLS \
326 Sym(asprintf$LDBLStub) \
330 Sym(fprintf$LDBLStub) \
331 Sym(fscanf$LDBLStub) \
332 Sym(fwprintf$LDBLStub) \
333 Sym(fwscanf$LDBLStub) \
334 Sym(printf$LDBLStub) \
335 Sym(scanf$LDBLStub) \
336 Sym(snprintf$LDBLStub) \
337 Sym(sprintf$LDBLStub) \
338 Sym(sscanf$LDBLStub) \
339 Sym(strtold$LDBLStub) \
340 Sym(swprintf$LDBLStub) \
341 Sym(swscanf$LDBLStub) \
342 Sym(syslog$LDBLStub) \
343 Sym(vasprintf$LDBLStub) \
345 Sym(verrc$LDBLStub) \
346 Sym(verrx$LDBLStub) \
347 Sym(vfprintf$LDBLStub) \
348 Sym(vfscanf$LDBLStub) \
349 Sym(vfwprintf$LDBLStub) \
350 Sym(vfwscanf$LDBLStub) \
351 Sym(vprintf$LDBLStub) \
352 Sym(vscanf$LDBLStub) \
353 Sym(vsnprintf$LDBLStub) \
354 Sym(vsprintf$LDBLStub) \
355 Sym(vsscanf$LDBLStub) \
356 Sym(vswprintf$LDBLStub) \
357 Sym(vswscanf$LDBLStub) \
358 Sym(vsyslog$LDBLStub) \
359 Sym(vwarn$LDBLStub) \
360 Sym(vwarnc$LDBLStub) \
361 Sym(vwarnx$LDBLStub) \
362 Sym(vwprintf$LDBLStub) \
363 Sym(vwscanf$LDBLStub) \
365 Sym(warnc$LDBLStub) \
366 Sym(warnx$LDBLStub) \
367 Sym(wcstold$LDBLStub) \
368 Sym(wprintf$LDBLStub) \
371 #define RTS_DARWIN_ONLY_SYMBOLS
375 # define MAIN_CAP_SYM SymX(MainCapability)
377 # define MAIN_CAP_SYM
380 #if !defined(mingw32_HOST_OS)
381 #define RTS_USER_SIGNALS_SYMBOLS \
382 SymX(startSignalHandler) \
383 SymX(setIOManagerPipe)
385 #define RTS_USER_SIGNALS_SYMBOLS /* nothing */
388 #ifdef TABLES_NEXT_TO_CODE
389 #define RTS_RET_SYMBOLS /* nothing */
391 #define RTS_RET_SYMBOLS \
392 SymX(stg_enter_ret) \
393 SymX(stg_gc_fun_ret) \
401 SymX(stg_ap_pv_ret) \
402 SymX(stg_ap_pp_ret) \
403 SymX(stg_ap_ppv_ret) \
404 SymX(stg_ap_ppp_ret) \
405 SymX(stg_ap_pppv_ret) \
406 SymX(stg_ap_pppp_ret) \
407 SymX(stg_ap_ppppp_ret) \
408 SymX(stg_ap_pppppp_ret)
411 #define RTS_SYMBOLS \
415 SymX(stg_enter_info) \
416 SymX(stg_gc_void_info) \
417 SymX(__stg_gc_enter_1) \
418 SymX(stg_gc_noregs) \
419 SymX(stg_gc_unpt_r1_info) \
420 SymX(stg_gc_unpt_r1) \
421 SymX(stg_gc_unbx_r1_info) \
422 SymX(stg_gc_unbx_r1) \
423 SymX(stg_gc_f1_info) \
425 SymX(stg_gc_d1_info) \
427 SymX(stg_gc_l1_info) \
430 SymX(stg_gc_fun_info) \
432 SymX(stg_gc_gen_info) \
433 SymX(stg_gc_gen_hp) \
435 SymX(stg_gen_yield) \
436 SymX(stg_yield_noregs) \
437 SymX(stg_yield_to_interpreter) \
438 SymX(stg_gen_block) \
439 SymX(stg_block_noregs) \
441 SymX(stg_block_takemvar) \
442 SymX(stg_block_putmvar) \
443 SymX(stg_seq_frame_info) \
445 SymX(MallocFailHook) \
447 SymX(OutOfHeapHook) \
448 SymX(StackOverflowHook) \
449 SymX(__encodeDouble) \
450 SymX(__encodeFloat) \
454 SymX(__gmpz_cmp_si) \
455 SymX(__gmpz_cmp_ui) \
456 SymX(__gmpz_get_si) \
457 SymX(__gmpz_get_ui) \
458 SymX(__int_encodeDouble) \
459 SymX(__int_encodeFloat) \
460 SymX(andIntegerzh_fast) \
461 SymX(atomicallyzh_fast) \
465 SymX(blockAsyncExceptionszh_fast) \
467 SymX(catchRetryzh_fast) \
468 SymX(catchSTMzh_fast) \
469 SymX(closure_flags) \
471 SymX(cmpIntegerzh_fast) \
472 SymX(cmpIntegerIntzh_fast) \
473 SymX(complementIntegerzh_fast) \
474 SymX(createAdjustor) \
475 SymX(decodeDoublezh_fast) \
476 SymX(decodeFloatzh_fast) \
479 SymX(deRefWeakzh_fast) \
480 SymX(deRefStablePtrzh_fast) \
481 SymX(divExactIntegerzh_fast) \
482 SymX(divModIntegerzh_fast) \
485 SymX(forkOS_createThread) \
486 SymX(freeHaskellFunctionPtr) \
487 SymX(freeStablePtr) \
488 SymX(gcdIntegerzh_fast) \
489 SymX(gcdIntegerIntzh_fast) \
490 SymX(gcdIntzh_fast) \
499 SymX(hs_perform_gc) \
500 SymX(hs_free_stable_ptr) \
501 SymX(hs_free_fun_ptr) \
503 SymX(int2Integerzh_fast) \
504 SymX(integer2Intzh_fast) \
505 SymX(integer2Wordzh_fast) \
506 SymX(isCurrentThreadBoundzh_fast) \
507 SymX(isDoubleDenormalized) \
508 SymX(isDoubleInfinite) \
510 SymX(isDoubleNegativeZero) \
511 SymX(isEmptyMVarzh_fast) \
512 SymX(isFloatDenormalized) \
513 SymX(isFloatInfinite) \
515 SymX(isFloatNegativeZero) \
516 SymX(killThreadzh_fast) \
519 SymX(makeStablePtrzh_fast) \
520 SymX(minusIntegerzh_fast) \
521 SymX(mkApUpd0zh_fast) \
522 SymX(myThreadIdzh_fast) \
523 SymX(labelThreadzh_fast) \
524 SymX(newArrayzh_fast) \
525 SymX(newBCOzh_fast) \
526 SymX(newByteArrayzh_fast) \
527 SymX_redirect(newCAF, newDynCAF) \
528 SymX(newMVarzh_fast) \
529 SymX(newMutVarzh_fast) \
530 SymX(newTVarzh_fast) \
531 SymX(atomicModifyMutVarzh_fast) \
532 SymX(newPinnedByteArrayzh_fast) \
533 SymX(orIntegerzh_fast) \
535 SymX(performMajorGC) \
536 SymX(plusIntegerzh_fast) \
539 SymX(putMVarzh_fast) \
540 SymX(quotIntegerzh_fast) \
541 SymX(quotRemIntegerzh_fast) \
543 SymX(raiseIOzh_fast) \
544 SymX(readTVarzh_fast) \
545 SymX(remIntegerzh_fast) \
546 SymX(resetNonBlockingFd) \
551 SymX(rts_checkSchedStatus) \
554 SymX(rts_evalLazyIO) \
555 SymX(rts_evalStableIO) \
559 SymX(rts_getDouble) \
564 SymX(rts_getFunPtr) \
565 SymX(rts_getStablePtr) \
566 SymX(rts_getThreadId) \
568 SymX(rts_getWord32) \
581 SymX(rts_mkStablePtr) \
589 SymX(rtsSupportsBoundThreads) \
591 SymX(__hscore_get_saved_termios) \
592 SymX(__hscore_set_saved_termios) \
594 SymX(startupHaskell) \
595 SymX(shutdownHaskell) \
596 SymX(shutdownHaskellAndExit) \
597 SymX(stable_ptr_table) \
598 SymX(stackOverflow) \
599 SymX(stg_CAF_BLACKHOLE_info) \
600 SymX(awakenBlockedQueue) \
601 SymX(stg_CHARLIKE_closure) \
602 SymX(stg_EMPTY_MVAR_info) \
603 SymX(stg_IND_STATIC_info) \
604 SymX(stg_INTLIKE_closure) \
605 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
606 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
607 SymX(stg_WEAK_info) \
608 SymX(stg_ap_0_info) \
609 SymX(stg_ap_v_info) \
610 SymX(stg_ap_f_info) \
611 SymX(stg_ap_d_info) \
612 SymX(stg_ap_l_info) \
613 SymX(stg_ap_n_info) \
614 SymX(stg_ap_p_info) \
615 SymX(stg_ap_pv_info) \
616 SymX(stg_ap_pp_info) \
617 SymX(stg_ap_ppv_info) \
618 SymX(stg_ap_ppp_info) \
619 SymX(stg_ap_pppv_info) \
620 SymX(stg_ap_pppp_info) \
621 SymX(stg_ap_ppppp_info) \
622 SymX(stg_ap_pppppp_info) \
623 SymX(stg_ap_1_upd_info) \
624 SymX(stg_ap_2_upd_info) \
625 SymX(stg_ap_3_upd_info) \
626 SymX(stg_ap_4_upd_info) \
627 SymX(stg_ap_5_upd_info) \
628 SymX(stg_ap_6_upd_info) \
629 SymX(stg_ap_7_upd_info) \
631 SymX(stg_sel_0_upd_info) \
632 SymX(stg_sel_10_upd_info) \
633 SymX(stg_sel_11_upd_info) \
634 SymX(stg_sel_12_upd_info) \
635 SymX(stg_sel_13_upd_info) \
636 SymX(stg_sel_14_upd_info) \
637 SymX(stg_sel_15_upd_info) \
638 SymX(stg_sel_1_upd_info) \
639 SymX(stg_sel_2_upd_info) \
640 SymX(stg_sel_3_upd_info) \
641 SymX(stg_sel_4_upd_info) \
642 SymX(stg_sel_5_upd_info) \
643 SymX(stg_sel_6_upd_info) \
644 SymX(stg_sel_7_upd_info) \
645 SymX(stg_sel_8_upd_info) \
646 SymX(stg_sel_9_upd_info) \
647 SymX(stg_upd_frame_info) \
648 SymX(suspendThread) \
649 SymX(takeMVarzh_fast) \
650 SymX(timesIntegerzh_fast) \
651 SymX(tryPutMVarzh_fast) \
652 SymX(tryTakeMVarzh_fast) \
653 SymX(unblockAsyncExceptionszh_fast) \
655 SymX(unsafeThawArrayzh_fast) \
656 SymX(waitReadzh_fast) \
657 SymX(waitWritezh_fast) \
658 SymX(word2Integerzh_fast) \
659 SymX(writeTVarzh_fast) \
660 SymX(xorIntegerzh_fast) \
662 RTS_USER_SIGNALS_SYMBOLS
664 #ifdef SUPPORT_LONG_LONGS
665 #define RTS_LONG_LONG_SYMS \
666 SymX(int64ToIntegerzh_fast) \
667 SymX(word64ToIntegerzh_fast)
669 #define RTS_LONG_LONG_SYMS /* nothing */
672 // 64-bit support functions in libgcc.a
673 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
674 #define RTS_LIBGCC_SYMBOLS \
684 #elif defined(ia64_HOST_ARCH)
685 #define RTS_LIBGCC_SYMBOLS \
693 #define RTS_LIBGCC_SYMBOLS
696 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
697 // Symbols that don't have a leading underscore
698 // on Mac OS X. They have to receive special treatment,
699 // see machoInitSymbolsWithoutUnderscore()
700 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
705 /* entirely bogus claims about types of these symbols */
706 #define Sym(vvv) extern void vvv(void);
707 #define SymX(vvv) /**/
708 #define SymX_redirect(vvv,xxx) /**/
712 RTS_POSIX_ONLY_SYMBOLS
713 RTS_MINGW_ONLY_SYMBOLS
714 RTS_CYGWIN_ONLY_SYMBOLS
715 RTS_DARWIN_ONLY_SYMBOLS
721 #ifdef LEADING_UNDERSCORE
722 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
724 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
727 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
729 #define SymX(vvv) Sym(vvv)
731 // SymX_redirect allows us to redirect references to one symbol to
732 // another symbol. See newCAF/newDynCAF for an example.
733 #define SymX_redirect(vvv,xxx) \
734 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
737 static RtsSymbolVal rtsSyms[] = {
741 RTS_POSIX_ONLY_SYMBOLS
742 RTS_MINGW_ONLY_SYMBOLS
743 RTS_CYGWIN_ONLY_SYMBOLS
745 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
746 // dyld stub code contains references to this,
747 // but it should never be called because we treat
748 // lazy pointers as nonlazy.
749 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
751 { 0, 0 } /* sentinel */
754 /* -----------------------------------------------------------------------------
755 * Insert symbols into hash tables, checking for duplicates.
757 static void ghciInsertStrHashTable ( char* obj_name,
763 if (lookupHashTable(table, (StgWord)key) == NULL)
765 insertStrHashTable(table, (StgWord)key, data);
770 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
772 "whilst processing object file\n"
774 "This could be caused by:\n"
775 " * Loading two different object files which export the same symbol\n"
776 " * Specifying the same object file twice on the GHCi command line\n"
777 " * An incorrect `package.conf' entry, causing some object to be\n"
779 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
788 /* -----------------------------------------------------------------------------
789 * initialize the object linker
793 static int linker_init_done = 0 ;
795 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
796 static void *dl_prog_handle;
799 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
800 #if defined(openbsd_HOST_OS)
801 static void *dl_libc_handle;
809 /* Make initLinker idempotent, so we can call it
810 before evey relevant operation; that means we
811 don't need to initialise the linker separately */
812 if (linker_init_done == 1) { return; } else {
813 linker_init_done = 1;
816 symhash = allocStrHashTable();
818 /* populate the symbol table with stuff from the RTS */
819 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
820 ghciInsertStrHashTable("(GHCi built-in symbols)",
821 symhash, sym->lbl, sym->addr);
823 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
824 machoInitSymbolsWithoutUnderscore();
827 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
828 # if defined(RTLD_DEFAULT)
829 dl_prog_handle = RTLD_DEFAULT;
831 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
832 # if defined(openbsd_HOST_OS)
833 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
835 # endif /* RTLD_DEFAULT */
839 /* -----------------------------------------------------------------------------
840 * Loading DLL or .so dynamic libraries
841 * -----------------------------------------------------------------------------
843 * Add a DLL from which symbols may be found. In the ELF case, just
844 * do RTLD_GLOBAL-style add, so no further messing around needs to
845 * happen in order that symbols in the loaded .so are findable --
846 * lookupSymbol() will subsequently see them by dlsym on the program's
847 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
849 * In the PEi386 case, open the DLLs and put handles to them in a
850 * linked list. When looking for a symbol, try all handles in the
851 * list. This means that we need to load even DLLs that are guaranteed
852 * to be in the ghc.exe image already, just so we can get a handle
853 * to give to loadSymbol, so that we can find the symbols. For such
854 * libraries, the LoadLibrary call should be a no-op except for returning
859 #if defined(OBJFORMAT_PEi386)
860 /* A record for storing handles into DLLs. */
865 struct _OpenedDLL* next;
870 /* A list thereof. */
871 static OpenedDLL* opened_dlls = NULL;
875 addDLL( char *dll_name )
877 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
878 /* ------------------- ELF DLL loader ------------------- */
884 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
887 /* dlopen failed; return a ptr to the error msg. */
889 if (errmsg == NULL) errmsg = "addDLL: unknown error";
896 # elif defined(OBJFORMAT_PEi386)
897 /* ------------------- Win32 DLL loader ------------------- */
905 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
907 /* See if we've already got it, and ignore if so. */
908 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
909 if (0 == strcmp(o_dll->name, dll_name))
913 /* The file name has no suffix (yet) so that we can try
914 both foo.dll and foo.drv
916 The documentation for LoadLibrary says:
917 If no file name extension is specified in the lpFileName
918 parameter, the default library extension .dll is
919 appended. However, the file name string can include a trailing
920 point character (.) to indicate that the module name has no
923 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
924 sprintf(buf, "%s.DLL", dll_name);
925 instance = LoadLibrary(buf);
926 if (instance == NULL) {
927 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
928 instance = LoadLibrary(buf);
929 if (instance == NULL) {
932 /* LoadLibrary failed; return a ptr to the error msg. */
933 return "addDLL: unknown error";
938 /* Add this DLL to the list of DLLs in which to search for symbols. */
939 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
940 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
941 strcpy(o_dll->name, dll_name);
942 o_dll->instance = instance;
943 o_dll->next = opened_dlls;
948 barf("addDLL: not implemented on this platform");
952 /* -----------------------------------------------------------------------------
953 * lookup a symbol in the hash table
956 lookupSymbol( char *lbl )
960 ASSERT(symhash != NULL);
961 val = lookupStrHashTable(symhash, lbl);
964 # if defined(OBJFORMAT_ELF)
965 # if defined(openbsd_HOST_OS)
966 val = dlsym(dl_prog_handle, lbl);
967 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
968 # elif defined(x86_64_HOST_ARCH)
969 val = dlsym(dl_prog_handle, lbl);
970 if (val >= (void *)0x80000000) {
972 new_val = x86_64_high_symbol(lbl, val);
973 IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
978 # else /* not openbsd */
979 return dlsym(dl_prog_handle, lbl);
981 # elif defined(OBJFORMAT_MACHO)
982 if(NSIsSymbolNameDefined(lbl)) {
983 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
984 return NSAddressOfSymbol(symbol);
988 # elif defined(OBJFORMAT_PEi386)
991 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
992 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
994 /* HACK: if the name has an initial underscore, try stripping
995 it off & look that up first. I've yet to verify whether there's
996 a Rule that governs whether an initial '_' *should always* be
997 stripped off when mapping from import lib name to the DLL name.
999 sym = GetProcAddress(o_dll->instance, (lbl+1));
1001 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
1005 sym = GetProcAddress(o_dll->instance, lbl);
1007 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
1022 __attribute((unused))
1024 lookupLocalSymbol( ObjectCode* oc, char *lbl )
1028 val = lookupStrHashTable(oc->lochash, lbl);
1038 /* -----------------------------------------------------------------------------
1039 * Debugging aid: look in GHCi's object symbol tables for symbols
1040 * within DELTA bytes of the specified address, and show their names.
1043 void ghci_enquire ( char* addr );
1045 void ghci_enquire ( char* addr )
1050 const int DELTA = 64;
1055 for (oc = objects; oc; oc = oc->next) {
1056 for (i = 0; i < oc->n_symbols; i++) {
1057 sym = oc->symbols[i];
1058 if (sym == NULL) continue;
1059 // debugBelch("enquire %p %p\n", sym, oc->lochash);
1061 if (oc->lochash != NULL) {
1062 a = lookupStrHashTable(oc->lochash, sym);
1065 a = lookupStrHashTable(symhash, sym);
1068 // debugBelch("ghci_enquire: can't find %s\n", sym);
1070 else if (addr-DELTA <= a && a <= addr+DELTA) {
1071 debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
1078 #ifdef ia64_HOST_ARCH
1079 static unsigned int PLTSize(void);
1082 /* -----------------------------------------------------------------------------
1083 * Load an obj (populate the global symbol table, but don't resolve yet)
1085 * Returns: 1 if ok, 0 on error.
1088 loadObj( char *path )
1095 void *map_addr = NULL;
1102 /* debugBelch("loadObj %s\n", path ); */
1104 /* Check that we haven't already loaded this object.
1105 Ignore requests to load multiple times */
1109 for (o = objects; o; o = o->next) {
1110 if (0 == strcmp(o->fileName, path)) {
1112 break; /* don't need to search further */
1116 IF_DEBUG(linker, debugBelch(
1117 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1118 "same object file twice:\n"
1120 "GHCi will ignore this, but be warned.\n"
1122 return 1; /* success */
1126 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1128 # if defined(OBJFORMAT_ELF)
1129 oc->formatName = "ELF";
1130 # elif defined(OBJFORMAT_PEi386)
1131 oc->formatName = "PEi386";
1132 # elif defined(OBJFORMAT_MACHO)
1133 oc->formatName = "Mach-O";
1136 barf("loadObj: not implemented on this platform");
1139 r = stat(path, &st);
1140 if (r == -1) { return 0; }
1142 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1143 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1144 strcpy(oc->fileName, path);
1146 oc->fileSize = st.st_size;
1148 oc->sections = NULL;
1149 oc->lochash = allocStrHashTable();
1150 oc->proddables = NULL;
1152 /* chain it onto the list of objects */
1157 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1159 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1161 #if defined(openbsd_HOST_OS)
1162 fd = open(path, O_RDONLY, S_IRUSR);
1164 fd = open(path, O_RDONLY);
1167 barf("loadObj: can't open `%s'", path);
1169 pagesize = getpagesize();
1171 #ifdef ia64_HOST_ARCH
1172 /* The PLT needs to be right before the object */
1173 n = ROUND_UP(PLTSize(), pagesize);
1174 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1175 if (oc->plt == MAP_FAILED)
1176 barf("loadObj: can't allocate PLT");
1179 map_addr = oc->plt + n;
1182 n = ROUND_UP(oc->fileSize, pagesize);
1184 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
1185 * small memory model on this architecture (see gcc docs,
1188 #ifdef x86_64_HOST_ARCH
1189 #define EXTRA_MAP_FLAGS MAP_32BIT
1191 #define EXTRA_MAP_FLAGS 0
1194 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1195 MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1196 if (oc->image == MAP_FAILED)
1197 barf("loadObj: can't map `%s'", path);
1201 #else /* !USE_MMAP */
1203 /* load the image into memory */
1204 f = fopen(path, "rb");
1206 barf("loadObj: can't read `%s'", path);
1208 #ifdef darwin_HOST_OS
1209 // In a Mach-O .o file, all sections can and will be misaligned
1210 // if the total size of the headers is not a multiple of the
1211 // desired alignment. This is fine for .o files that only serve
1212 // as input for the static linker, but it's not fine for us,
1213 // as SSE (used by gcc for floating point) and Altivec require
1214 // 16-byte alignment.
1215 // We calculate the correct alignment from the header before
1216 // reading the file, and then we misalign oc->image on purpose so
1217 // that the actual sections end up aligned again.
1218 misalignment = machoGetMisalignment(f);
1223 oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)");
1224 oc->image += misalignment;
1226 n = fread ( oc->image, 1, oc->fileSize, f );
1227 if (n != oc->fileSize)
1228 barf("loadObj: error whilst reading `%s'", path);
1232 #endif /* USE_MMAP */
1234 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1235 r = ocAllocateJumpIslands_MachO ( oc );
1236 if (!r) { return r; }
1237 # elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
1238 r = ocAllocateJumpIslands_ELF ( oc );
1239 if (!r) { return r; }
1242 /* verify the in-memory image */
1243 # if defined(OBJFORMAT_ELF)
1244 r = ocVerifyImage_ELF ( oc );
1245 # elif defined(OBJFORMAT_PEi386)
1246 r = ocVerifyImage_PEi386 ( oc );
1247 # elif defined(OBJFORMAT_MACHO)
1248 r = ocVerifyImage_MachO ( oc );
1250 barf("loadObj: no verify method");
1252 if (!r) { return r; }
1254 /* build the symbol list for this image */
1255 # if defined(OBJFORMAT_ELF)
1256 r = ocGetNames_ELF ( oc );
1257 # elif defined(OBJFORMAT_PEi386)
1258 r = ocGetNames_PEi386 ( oc );
1259 # elif defined(OBJFORMAT_MACHO)
1260 r = ocGetNames_MachO ( oc );
1262 barf("loadObj: no getNames method");
1264 if (!r) { return r; }
1266 /* loaded, but not resolved yet */
1267 oc->status = OBJECT_LOADED;
1272 /* -----------------------------------------------------------------------------
1273 * resolve all the currently unlinked objects in memory
1275 * Returns: 1 if ok, 0 on error.
1285 for (oc = objects; oc; oc = oc->next) {
1286 if (oc->status != OBJECT_RESOLVED) {
1287 # if defined(OBJFORMAT_ELF)
1288 r = ocResolve_ELF ( oc );
1289 # elif defined(OBJFORMAT_PEi386)
1290 r = ocResolve_PEi386 ( oc );
1291 # elif defined(OBJFORMAT_MACHO)
1292 r = ocResolve_MachO ( oc );
1294 barf("resolveObjs: not implemented on this platform");
1296 if (!r) { return r; }
1297 oc->status = OBJECT_RESOLVED;
1303 /* -----------------------------------------------------------------------------
1304 * delete an object from the pool
1307 unloadObj( char *path )
1309 ObjectCode *oc, *prev;
1311 ASSERT(symhash != NULL);
1312 ASSERT(objects != NULL);
1317 for (oc = objects; oc; prev = oc, oc = oc->next) {
1318 if (!strcmp(oc->fileName,path)) {
1320 /* Remove all the mappings for the symbols within this
1325 for (i = 0; i < oc->n_symbols; i++) {
1326 if (oc->symbols[i] != NULL) {
1327 removeStrHashTable(symhash, oc->symbols[i], NULL);
1335 prev->next = oc->next;
1338 /* We're going to leave this in place, in case there are
1339 any pointers from the heap into it: */
1340 /* stgFree(oc->image); */
1341 stgFree(oc->fileName);
1342 stgFree(oc->symbols);
1343 stgFree(oc->sections);
1344 /* The local hash table should have been freed at the end
1345 of the ocResolve_ call on it. */
1346 ASSERT(oc->lochash == NULL);
1352 errorBelch("unloadObj: can't find `%s' to unload", path);
1356 /* -----------------------------------------------------------------------------
1357 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1358 * which may be prodded during relocation, and abort if we try and write
1359 * outside any of these.
1361 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1364 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1365 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1369 pb->next = oc->proddables;
1370 oc->proddables = pb;
1373 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1376 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1377 char* s = (char*)(pb->start);
1378 char* e = s + pb->size - 1;
1379 char* a = (char*)addr;
1380 /* Assumes that the biggest fixup involves a 4-byte write. This
1381 probably needs to be changed to 8 (ie, +7) on 64-bit
1383 if (a >= s && (a+3) <= e) return;
1385 barf("checkProddableBlock: invalid fixup in runtime linker");
1388 /* -----------------------------------------------------------------------------
1389 * Section management.
1391 static void addSection ( ObjectCode* oc, SectionKind kind,
1392 void* start, void* end )
1394 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1398 s->next = oc->sections;
1401 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1402 start, ((char*)end)-1, end - start + 1, kind );
1407 /* --------------------------------------------------------------------------
1408 * PowerPC specifics (jump islands)
1409 * ------------------------------------------------------------------------*/
1411 #if defined(powerpc_HOST_ARCH)
1414 ocAllocateJumpIslands
1416 Allocate additional space at the end of the object file image to make room
1419 PowerPC relative branch instructions have a 24 bit displacement field.
1420 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1421 If a particular imported symbol is outside this range, we have to redirect
1422 the jump to a short piece of new code that just loads the 32bit absolute
1423 address and jumps there.
1424 This function just allocates space for one 16 byte ppcJumpIsland for every
1425 undefined symbol in the object file. The code for the islands is filled in by
1426 makeJumpIsland below.
1429 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1438 // round up to the nearest 4
1439 aligned = (oc->fileSize + 3) & ~3;
1442 #ifndef linux_HOST_OS /* mremap is a linux extension */
1443 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1446 pagesize = getpagesize();
1447 n = ROUND_UP( oc->fileSize, pagesize );
1448 m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
1450 /* The effect of this mremap() call is only the ensure that we have
1451 * a sufficient number of virtually contiguous pages. As returned from
1452 * mremap, the pages past the end of the file are not backed. We give
1453 * them a backing by using MAP_FIXED to map in anonymous pages.
1455 if( (oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE )) == MAP_FAILED )
1457 errorBelch( "Unable to mremap for Jump Islands\n" );
1461 if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
1462 MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
1464 errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
1469 oc->image = stgReallocBytes( oc->image,
1470 aligned + sizeof (ppcJumpIsland) * count,
1471 "ocAllocateJumpIslands" );
1472 #endif /* USE_MMAP */
1474 oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
1475 memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
1478 oc->jump_islands = NULL;
1480 oc->island_start_symbol = first;
1481 oc->n_islands = count;
1486 static unsigned long makeJumpIsland( ObjectCode* oc,
1487 unsigned long symbolNumber,
1488 unsigned long target )
1490 ppcJumpIsland *island;
1492 if( symbolNumber < oc->island_start_symbol ||
1493 symbolNumber - oc->island_start_symbol > oc->n_islands)
1496 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1498 // lis r12, hi16(target)
1499 island->lis_r12 = 0x3d80;
1500 island->hi_addr = target >> 16;
1502 // ori r12, r12, lo16(target)
1503 island->ori_r12_r12 = 0x618c;
1504 island->lo_addr = target & 0xffff;
1507 island->mtctr_r12 = 0x7d8903a6;
1510 island->bctr = 0x4e800420;
1512 return (unsigned long) island;
1516 ocFlushInstructionCache
1518 Flush the data & instruction caches.
1519 Because the PPC has split data/instruction caches, we have to
1520 do that whenever we modify code at runtime.
1523 static void ocFlushInstructionCache( ObjectCode *oc )
1525 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1526 unsigned long *p = (unsigned long *) oc->image;
1530 __asm__ volatile ( "dcbf 0,%0\n\t"
1538 __asm__ volatile ( "sync\n\t"
1544 /* --------------------------------------------------------------------------
1545 * PEi386 specifics (Win32 targets)
1546 * ------------------------------------------------------------------------*/
1548 /* The information for this linker comes from
1549 Microsoft Portable Executable
1550 and Common Object File Format Specification
1551 revision 5.1 January 1998
1552 which SimonM says comes from the MS Developer Network CDs.
1554 It can be found there (on older CDs), but can also be found
1557 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1559 (this is Rev 6.0 from February 1999).
1561 Things move, so if that fails, try searching for it via
1563 http://www.google.com/search?q=PE+COFF+specification
1565 The ultimate reference for the PE format is the Winnt.h
1566 header file that comes with the Platform SDKs; as always,
1567 implementations will drift wrt their documentation.
1569 A good background article on the PE format is Matt Pietrek's
1570 March 1994 article in Microsoft System Journal (MSJ)
1571 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1572 Win32 Portable Executable File Format." The info in there
1573 has recently been updated in a two part article in
1574 MSDN magazine, issues Feb and March 2002,
1575 "Inside Windows: An In-Depth Look into the Win32 Portable
1576 Executable File Format"
1578 John Levine's book "Linkers and Loaders" contains useful
1583 #if defined(OBJFORMAT_PEi386)
1587 typedef unsigned char UChar;
1588 typedef unsigned short UInt16;
1589 typedef unsigned int UInt32;
1596 UInt16 NumberOfSections;
1597 UInt32 TimeDateStamp;
1598 UInt32 PointerToSymbolTable;
1599 UInt32 NumberOfSymbols;
1600 UInt16 SizeOfOptionalHeader;
1601 UInt16 Characteristics;
1605 #define sizeof_COFF_header 20
1612 UInt32 VirtualAddress;
1613 UInt32 SizeOfRawData;
1614 UInt32 PointerToRawData;
1615 UInt32 PointerToRelocations;
1616 UInt32 PointerToLinenumbers;
1617 UInt16 NumberOfRelocations;
1618 UInt16 NumberOfLineNumbers;
1619 UInt32 Characteristics;
1623 #define sizeof_COFF_section 40
1630 UInt16 SectionNumber;
1633 UChar NumberOfAuxSymbols;
1637 #define sizeof_COFF_symbol 18
1642 UInt32 VirtualAddress;
1643 UInt32 SymbolTableIndex;
1648 #define sizeof_COFF_reloc 10
1651 /* From PE spec doc, section 3.3.2 */
1652 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1653 windows.h -- for the same purpose, but I want to know what I'm
1655 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1656 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1657 #define MYIMAGE_FILE_DLL 0x2000
1658 #define MYIMAGE_FILE_SYSTEM 0x1000
1659 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1660 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1661 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1663 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1664 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1665 #define MYIMAGE_SYM_CLASS_STATIC 3
1666 #define MYIMAGE_SYM_UNDEFINED 0
1668 /* From PE spec doc, section 4.1 */
1669 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1670 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1671 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1673 /* From PE spec doc, section 5.2.1 */
1674 #define MYIMAGE_REL_I386_DIR32 0x0006
1675 #define MYIMAGE_REL_I386_REL32 0x0014
1678 /* We use myindex to calculate array addresses, rather than
1679 simply doing the normal subscript thing. That's because
1680 some of the above structs have sizes which are not
1681 a whole number of words. GCC rounds their sizes up to a
1682 whole number of words, which means that the address calcs
1683 arising from using normal C indexing or pointer arithmetic
1684 are just plain wrong. Sigh.
1687 myindex ( int scale, void* base, int index )
1690 ((UChar*)base) + scale * index;
1695 printName ( UChar* name, UChar* strtab )
1697 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1698 UInt32 strtab_offset = * (UInt32*)(name+4);
1699 debugBelch("%s", strtab + strtab_offset );
1702 for (i = 0; i < 8; i++) {
1703 if (name[i] == 0) break;
1704 debugBelch("%c", name[i] );
1711 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1713 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1714 UInt32 strtab_offset = * (UInt32*)(name+4);
1715 strncpy ( dst, strtab+strtab_offset, dstSize );
1721 if (name[i] == 0) break;
1731 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1734 /* If the string is longer than 8 bytes, look in the
1735 string table for it -- this will be correctly zero terminated.
1737 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1738 UInt32 strtab_offset = * (UInt32*)(name+4);
1739 return ((UChar*)strtab) + strtab_offset;
1741 /* Otherwise, if shorter than 8 bytes, return the original,
1742 which by defn is correctly terminated.
1744 if (name[7]==0) return name;
1745 /* The annoying case: 8 bytes. Copy into a temporary
1746 (which is never freed ...)
1748 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1750 strncpy(newstr,name,8);
1756 /* Just compares the short names (first 8 chars) */
1757 static COFF_section *
1758 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1762 = (COFF_header*)(oc->image);
1763 COFF_section* sectab
1765 ((UChar*)(oc->image))
1766 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1768 for (i = 0; i < hdr->NumberOfSections; i++) {
1771 COFF_section* section_i
1773 myindex ( sizeof_COFF_section, sectab, i );
1774 n1 = (UChar*) &(section_i->Name);
1776 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1777 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1778 n1[6]==n2[6] && n1[7]==n2[7])
1787 zapTrailingAtSign ( UChar* sym )
1789 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1791 if (sym[0] == 0) return;
1793 while (sym[i] != 0) i++;
1796 while (j > 0 && my_isdigit(sym[j])) j--;
1797 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1803 ocVerifyImage_PEi386 ( ObjectCode* oc )
1808 COFF_section* sectab;
1809 COFF_symbol* symtab;
1811 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1812 hdr = (COFF_header*)(oc->image);
1813 sectab = (COFF_section*) (
1814 ((UChar*)(oc->image))
1815 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1817 symtab = (COFF_symbol*) (
1818 ((UChar*)(oc->image))
1819 + hdr->PointerToSymbolTable
1821 strtab = ((UChar*)symtab)
1822 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1824 if (hdr->Machine != 0x14c) {
1825 errorBelch("%s: Not x86 PEi386", oc->fileName);
1828 if (hdr->SizeOfOptionalHeader != 0) {
1829 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
1832 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1833 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1834 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1835 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1836 errorBelch("%s: Not a PEi386 object file", oc->fileName);
1839 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1840 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1841 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
1843 (int)(hdr->Characteristics));
1846 /* If the string table size is way crazy, this might indicate that
1847 there are more than 64k relocations, despite claims to the
1848 contrary. Hence this test. */
1849 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1851 if ( (*(UInt32*)strtab) > 600000 ) {
1852 /* Note that 600k has no special significance other than being
1853 big enough to handle the almost-2MB-sized lumps that
1854 constitute HSwin32*.o. */
1855 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1860 /* No further verification after this point; only debug printing. */
1862 IF_DEBUG(linker, i=1);
1863 if (i == 0) return 1;
1865 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1866 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1867 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1870 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1871 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1872 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1873 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1874 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1875 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1876 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1878 /* Print the section table. */
1880 for (i = 0; i < hdr->NumberOfSections; i++) {
1882 COFF_section* sectab_i
1884 myindex ( sizeof_COFF_section, sectab, i );
1891 printName ( sectab_i->Name, strtab );
1901 sectab_i->VirtualSize,
1902 sectab_i->VirtualAddress,
1903 sectab_i->SizeOfRawData,
1904 sectab_i->PointerToRawData,
1905 sectab_i->NumberOfRelocations,
1906 sectab_i->PointerToRelocations,
1907 sectab_i->PointerToRawData
1909 reltab = (COFF_reloc*) (
1910 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1913 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1914 /* If the relocation field (a short) has overflowed, the
1915 * real count can be found in the first reloc entry.
1917 * See Section 4.1 (last para) of the PE spec (rev6.0).
1919 COFF_reloc* rel = (COFF_reloc*)
1920 myindex ( sizeof_COFF_reloc, reltab, 0 );
1921 noRelocs = rel->VirtualAddress;
1924 noRelocs = sectab_i->NumberOfRelocations;
1928 for (; j < noRelocs; j++) {
1930 COFF_reloc* rel = (COFF_reloc*)
1931 myindex ( sizeof_COFF_reloc, reltab, j );
1933 " type 0x%-4x vaddr 0x%-8x name `",
1935 rel->VirtualAddress );
1936 sym = (COFF_symbol*)
1937 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1938 /* Hmm..mysterious looking offset - what's it for? SOF */
1939 printName ( sym->Name, strtab -10 );
1946 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
1947 debugBelch("---START of string table---\n");
1948 for (i = 4; i < *(Int32*)strtab; i++) {
1950 debugBelch("\n"); else
1951 debugBelch("%c", strtab[i] );
1953 debugBelch("--- END of string table---\n");
1958 COFF_symbol* symtab_i;
1959 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1960 symtab_i = (COFF_symbol*)
1961 myindex ( sizeof_COFF_symbol, symtab, i );
1967 printName ( symtab_i->Name, strtab );
1976 (Int32)(symtab_i->SectionNumber),
1977 (UInt32)symtab_i->Type,
1978 (UInt32)symtab_i->StorageClass,
1979 (UInt32)symtab_i->NumberOfAuxSymbols
1981 i += symtab_i->NumberOfAuxSymbols;
1991 ocGetNames_PEi386 ( ObjectCode* oc )
1994 COFF_section* sectab;
1995 COFF_symbol* symtab;
2002 hdr = (COFF_header*)(oc->image);
2003 sectab = (COFF_section*) (
2004 ((UChar*)(oc->image))
2005 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2007 symtab = (COFF_symbol*) (
2008 ((UChar*)(oc->image))
2009 + hdr->PointerToSymbolTable
2011 strtab = ((UChar*)(oc->image))
2012 + hdr->PointerToSymbolTable
2013 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2015 /* Allocate space for any (local, anonymous) .bss sections. */
2017 for (i = 0; i < hdr->NumberOfSections; i++) {
2019 COFF_section* sectab_i
2021 myindex ( sizeof_COFF_section, sectab, i );
2022 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2023 if (sectab_i->VirtualSize == 0) continue;
2024 /* This is a non-empty .bss section. Allocate zeroed space for
2025 it, and set its PointerToRawData field such that oc->image +
2026 PointerToRawData == addr_of_zeroed_space. */
2027 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
2028 "ocGetNames_PEi386(anonymous bss)");
2029 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2030 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
2031 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2034 /* Copy section information into the ObjectCode. */
2036 for (i = 0; i < hdr->NumberOfSections; i++) {
2042 = SECTIONKIND_OTHER;
2043 COFF_section* sectab_i
2045 myindex ( sizeof_COFF_section, sectab, i );
2046 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2049 /* I'm sure this is the Right Way to do it. However, the
2050 alternative of testing the sectab_i->Name field seems to
2051 work ok with Cygwin.
2053 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2054 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2055 kind = SECTIONKIND_CODE_OR_RODATA;
2058 if (0==strcmp(".text",sectab_i->Name) ||
2059 0==strcmp(".rdata",sectab_i->Name)||
2060 0==strcmp(".rodata",sectab_i->Name))
2061 kind = SECTIONKIND_CODE_OR_RODATA;
2062 if (0==strcmp(".data",sectab_i->Name) ||
2063 0==strcmp(".bss",sectab_i->Name))
2064 kind = SECTIONKIND_RWDATA;
2066 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2067 sz = sectab_i->SizeOfRawData;
2068 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2070 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2071 end = start + sz - 1;
2073 if (kind == SECTIONKIND_OTHER
2074 /* Ignore sections called which contain stabs debugging
2076 && 0 != strcmp(".stab", sectab_i->Name)
2077 && 0 != strcmp(".stabstr", sectab_i->Name)
2078 /* ignore constructor section for now */
2079 && 0 != strcmp(".ctors", sectab_i->Name)
2081 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2085 if (kind != SECTIONKIND_OTHER && end >= start) {
2086 addSection(oc, kind, start, end);
2087 addProddableBlock(oc, start, end - start + 1);
2091 /* Copy exported symbols into the ObjectCode. */
2093 oc->n_symbols = hdr->NumberOfSymbols;
2094 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2095 "ocGetNames_PEi386(oc->symbols)");
2096 /* Call me paranoid; I don't care. */
2097 for (i = 0; i < oc->n_symbols; i++)
2098 oc->symbols[i] = NULL;
2102 COFF_symbol* symtab_i;
2103 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2104 symtab_i = (COFF_symbol*)
2105 myindex ( sizeof_COFF_symbol, symtab, i );
2109 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2110 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2111 /* This symbol is global and defined, viz, exported */
2112 /* for MYIMAGE_SYMCLASS_EXTERNAL
2113 && !MYIMAGE_SYM_UNDEFINED,
2114 the address of the symbol is:
2115 address of relevant section + offset in section
2117 COFF_section* sectabent
2118 = (COFF_section*) myindex ( sizeof_COFF_section,
2120 symtab_i->SectionNumber-1 );
2121 addr = ((UChar*)(oc->image))
2122 + (sectabent->PointerToRawData
2126 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2127 && symtab_i->Value > 0) {
2128 /* This symbol isn't in any section at all, ie, global bss.
2129 Allocate zeroed space for it. */
2130 addr = stgCallocBytes(1, symtab_i->Value,
2131 "ocGetNames_PEi386(non-anonymous bss)");
2132 addSection(oc, SECTIONKIND_RWDATA, addr,
2133 ((UChar*)addr) + symtab_i->Value - 1);
2134 addProddableBlock(oc, addr, symtab_i->Value);
2135 /* debugBelch("BSS section at 0x%x\n", addr); */
2138 if (addr != NULL ) {
2139 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2140 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2141 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2142 ASSERT(i >= 0 && i < oc->n_symbols);
2143 /* cstring_from_COFF_symbol_name always succeeds. */
2144 oc->symbols[i] = sname;
2145 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2149 "IGNORING symbol %d\n"
2153 printName ( symtab_i->Name, strtab );
2162 (Int32)(symtab_i->SectionNumber),
2163 (UInt32)symtab_i->Type,
2164 (UInt32)symtab_i->StorageClass,
2165 (UInt32)symtab_i->NumberOfAuxSymbols
2170 i += symtab_i->NumberOfAuxSymbols;
2179 ocResolve_PEi386 ( ObjectCode* oc )
2182 COFF_section* sectab;
2183 COFF_symbol* symtab;
2193 /* ToDo: should be variable-sized? But is at least safe in the
2194 sense of buffer-overrun-proof. */
2196 /* debugBelch("resolving for %s\n", oc->fileName); */
2198 hdr = (COFF_header*)(oc->image);
2199 sectab = (COFF_section*) (
2200 ((UChar*)(oc->image))
2201 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2203 symtab = (COFF_symbol*) (
2204 ((UChar*)(oc->image))
2205 + hdr->PointerToSymbolTable
2207 strtab = ((UChar*)(oc->image))
2208 + hdr->PointerToSymbolTable
2209 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2211 for (i = 0; i < hdr->NumberOfSections; i++) {
2212 COFF_section* sectab_i
2214 myindex ( sizeof_COFF_section, sectab, i );
2217 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2220 /* Ignore sections called which contain stabs debugging
2222 if (0 == strcmp(".stab", sectab_i->Name)
2223 || 0 == strcmp(".stabstr", sectab_i->Name)
2224 || 0 == strcmp(".ctors", sectab_i->Name))
2227 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2228 /* If the relocation field (a short) has overflowed, the
2229 * real count can be found in the first reloc entry.
2231 * See Section 4.1 (last para) of the PE spec (rev6.0).
2233 * Nov2003 update: the GNU linker still doesn't correctly
2234 * handle the generation of relocatable object files with
2235 * overflown relocations. Hence the output to warn of potential
2238 COFF_reloc* rel = (COFF_reloc*)
2239 myindex ( sizeof_COFF_reloc, reltab, 0 );
2240 noRelocs = rel->VirtualAddress;
2241 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2245 noRelocs = sectab_i->NumberOfRelocations;
2250 for (; j < noRelocs; j++) {
2252 COFF_reloc* reltab_j
2254 myindex ( sizeof_COFF_reloc, reltab, j );
2256 /* the location to patch */
2258 ((UChar*)(oc->image))
2259 + (sectab_i->PointerToRawData
2260 + reltab_j->VirtualAddress
2261 - sectab_i->VirtualAddress )
2263 /* the existing contents of pP */
2265 /* the symbol to connect to */
2266 sym = (COFF_symbol*)
2267 myindex ( sizeof_COFF_symbol,
2268 symtab, reltab_j->SymbolTableIndex );
2271 "reloc sec %2d num %3d: type 0x%-4x "
2272 "vaddr 0x%-8x name `",
2274 (UInt32)reltab_j->Type,
2275 reltab_j->VirtualAddress );
2276 printName ( sym->Name, strtab );
2277 debugBelch("'\n" ));
2279 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2280 COFF_section* section_sym
2281 = findPEi386SectionCalled ( oc, sym->Name );
2283 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2286 S = ((UInt32)(oc->image))
2287 + (section_sym->PointerToRawData
2290 copyName ( sym->Name, strtab, symbol, 1000-1 );
2291 (void*)S = lookupLocalSymbol( oc, symbol );
2292 if ((void*)S != NULL) goto foundit;
2293 (void*)S = lookupSymbol( symbol );
2294 if ((void*)S != NULL) goto foundit;
2295 zapTrailingAtSign ( symbol );
2296 (void*)S = lookupLocalSymbol( oc, symbol );
2297 if ((void*)S != NULL) goto foundit;
2298 (void*)S = lookupSymbol( symbol );
2299 if ((void*)S != NULL) goto foundit;
2300 /* Newline first because the interactive linker has printed "linking..." */
2301 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2305 checkProddableBlock(oc, pP);
2306 switch (reltab_j->Type) {
2307 case MYIMAGE_REL_I386_DIR32:
2310 case MYIMAGE_REL_I386_REL32:
2311 /* Tricky. We have to insert a displacement at
2312 pP which, when added to the PC for the _next_
2313 insn, gives the address of the target (S).
2314 Problem is to know the address of the next insn
2315 when we only know pP. We assume that this
2316 literal field is always the last in the insn,
2317 so that the address of the next insn is pP+4
2318 -- hence the constant 4.
2319 Also I don't know if A should be added, but so
2320 far it has always been zero.
2322 SOF 05/2005: 'A' (old contents of *pP) have been observed
2323 to contain values other than zero (the 'wx' object file
2324 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2325 So, add displacement to old value instead of asserting
2326 A to be zero. Fixes wxhaskell-related crashes, and no other
2327 ill effects have been observed.
2329 Update: the reason why we're seeing these more elaborate
2330 relocations is due to a switch in how the NCG compiles SRTs
2331 and offsets to them from info tables. SRTs live in .(ro)data,
2332 while info tables live in .text, causing GAS to emit REL32/DISP32
2333 relocations with non-zero values. Adding the displacement is
2334 the right thing to do.
2336 *pP = S - ((UInt32)pP) - 4 + A;
2339 debugBelch("%s: unhandled PEi386 relocation type %d",
2340 oc->fileName, reltab_j->Type);
2347 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2351 #endif /* defined(OBJFORMAT_PEi386) */
2354 /* --------------------------------------------------------------------------
2356 * ------------------------------------------------------------------------*/
2358 #if defined(OBJFORMAT_ELF)
2363 #if defined(sparc_HOST_ARCH)
2364 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2365 #elif defined(i386_HOST_ARCH)
2366 # define ELF_TARGET_386 /* Used inside <elf.h> */
2367 #elif defined(x86_64_HOST_ARCH)
2368 # define ELF_TARGET_X64_64
2370 #elif defined (ia64_HOST_ARCH)
2371 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2373 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2374 # define ELF_NEED_GOT /* needs Global Offset Table */
2375 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2378 #if !defined(openbsd_HOST_OS)
2381 /* openbsd elf has things in different places, with diff names */
2382 #include <elf_abi.h>
2383 #include <machine/reloc.h>
2384 #define R_386_32 RELOC_32
2385 #define R_386_PC32 RELOC_PC32
2389 * Define a set of types which can be used for both ELF32 and ELF64
2393 #define ELFCLASS ELFCLASS64
2394 #define Elf_Addr Elf64_Addr
2395 #define Elf_Word Elf64_Word
2396 #define Elf_Sword Elf64_Sword
2397 #define Elf_Ehdr Elf64_Ehdr
2398 #define Elf_Phdr Elf64_Phdr
2399 #define Elf_Shdr Elf64_Shdr
2400 #define Elf_Sym Elf64_Sym
2401 #define Elf_Rel Elf64_Rel
2402 #define Elf_Rela Elf64_Rela
2403 #define ELF_ST_TYPE ELF64_ST_TYPE
2404 #define ELF_ST_BIND ELF64_ST_BIND
2405 #define ELF_R_TYPE ELF64_R_TYPE
2406 #define ELF_R_SYM ELF64_R_SYM
2408 #define ELFCLASS ELFCLASS32
2409 #define Elf_Addr Elf32_Addr
2410 #define Elf_Word Elf32_Word
2411 #define Elf_Sword Elf32_Sword
2412 #define Elf_Ehdr Elf32_Ehdr
2413 #define Elf_Phdr Elf32_Phdr
2414 #define Elf_Shdr Elf32_Shdr
2415 #define Elf_Sym Elf32_Sym
2416 #define Elf_Rel Elf32_Rel
2417 #define Elf_Rela Elf32_Rela
2419 #define ELF_ST_TYPE ELF32_ST_TYPE
2422 #define ELF_ST_BIND ELF32_ST_BIND
2425 #define ELF_R_TYPE ELF32_R_TYPE
2428 #define ELF_R_SYM ELF32_R_SYM
2434 * Functions to allocate entries in dynamic sections. Currently we simply
2435 * preallocate a large number, and we don't check if a entry for the given
2436 * target already exists (a linear search is too slow). Ideally these
2437 * entries would be associated with symbols.
2440 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2441 #define GOT_SIZE 0x20000
2442 #define FUNCTION_TABLE_SIZE 0x10000
2443 #define PLT_SIZE 0x08000
2446 static Elf_Addr got[GOT_SIZE];
2447 static unsigned int gotIndex;
2448 static Elf_Addr gp_val = (Elf_Addr)got;
2451 allocateGOTEntry(Elf_Addr target)
2455 if (gotIndex >= GOT_SIZE)
2456 barf("Global offset table overflow");
2458 entry = &got[gotIndex++];
2460 return (Elf_Addr)entry;
2464 #ifdef ELF_FUNCTION_DESC
2470 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2471 static unsigned int functionTableIndex;
2474 allocateFunctionDesc(Elf_Addr target)
2476 FunctionDesc *entry;
2478 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2479 barf("Function table overflow");
2481 entry = &functionTable[functionTableIndex++];
2483 entry->gp = (Elf_Addr)gp_val;
2484 return (Elf_Addr)entry;
2488 copyFunctionDesc(Elf_Addr target)
2490 FunctionDesc *olddesc = (FunctionDesc *)target;
2491 FunctionDesc *newdesc;
2493 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2494 newdesc->gp = olddesc->gp;
2495 return (Elf_Addr)newdesc;
2500 #ifdef ia64_HOST_ARCH
2501 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2502 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2504 static unsigned char plt_code[] =
2506 /* taken from binutils bfd/elfxx-ia64.c */
2507 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2508 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2509 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2510 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2511 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2512 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2515 /* If we can't get to the function descriptor via gp, take a local copy of it */
2516 #define PLT_RELOC(code, target) { \
2517 Elf64_Sxword rel_value = target - gp_val; \
2518 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2519 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2521 ia64_reloc_gprel22((Elf_Addr)code, target); \
2526 unsigned char code[sizeof(plt_code)];
2530 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2532 PLTEntry *plt = (PLTEntry *)oc->plt;
2535 if (oc->pltIndex >= PLT_SIZE)
2536 barf("Procedure table overflow");
2538 entry = &plt[oc->pltIndex++];
2539 memcpy(entry->code, plt_code, sizeof(entry->code));
2540 PLT_RELOC(entry->code, target);
2541 return (Elf_Addr)entry;
2547 return (PLT_SIZE * sizeof(PLTEntry));
2552 #if x86_64_HOST_ARCH
2553 // On x86_64, 32-bit relocations are often used, which requires that
2554 // we can resolve a symbol to a 32-bit offset. However, shared
2555 // libraries are placed outside the 2Gb area, which leaves us with a
2556 // problem when we need to give a 32-bit offset to a symbol in a
2559 // For a function symbol, we can allocate a bounce sequence inside the
2560 // 2Gb area and resolve the symbol to this. The bounce sequence is
2561 // simply a long jump instruction to the real location of the symbol.
2563 // For data references, we're screwed.
2566 unsigned char jmp[8]; /* 6 byte instruction: jmpq *0x00000002(%rip) */
2570 #define X86_64_BB_SIZE 1024
2572 static x86_64_bounce *x86_64_bounce_buffer = NULL;
2573 static nat x86_64_bb_next_off;
2576 x86_64_high_symbol( char *lbl, void *addr )
2578 x86_64_bounce *bounce;
2580 if ( x86_64_bounce_buffer == NULL ||
2581 x86_64_bb_next_off >= X86_64_BB_SIZE ) {
2582 x86_64_bounce_buffer =
2583 mmap(NULL, X86_64_BB_SIZE * sizeof(x86_64_bounce),
2584 PROT_EXEC|PROT_READ|PROT_WRITE,
2585 MAP_PRIVATE|MAP_32BIT|MAP_ANONYMOUS, -1, 0);
2586 if (x86_64_bounce_buffer == MAP_FAILED) {
2587 barf("x86_64_high_symbol: mmap failed");
2589 x86_64_bb_next_off = 0;
2591 bounce = &x86_64_bounce_buffer[x86_64_bb_next_off];
2592 bounce->jmp[0] = 0xff;
2593 bounce->jmp[1] = 0x25;
2594 bounce->jmp[2] = 0x02;
2595 bounce->jmp[3] = 0x00;
2596 bounce->jmp[4] = 0x00;
2597 bounce->jmp[5] = 0x00;
2598 bounce->addr = addr;
2599 x86_64_bb_next_off++;
2601 IF_DEBUG(linker, debugBelch("x86_64: allocated bounce entry for %s->%p at %p\n",
2602 lbl, addr, bounce));
2604 insertStrHashTable(symhash, lbl, bounce);
2611 * Generic ELF functions
2615 findElfSection ( void* objImage, Elf_Word sh_type )
2617 char* ehdrC = (char*)objImage;
2618 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2619 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2620 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2624 for (i = 0; i < ehdr->e_shnum; i++) {
2625 if (shdr[i].sh_type == sh_type
2626 /* Ignore the section header's string table. */
2627 && i != ehdr->e_shstrndx
2628 /* Ignore string tables named .stabstr, as they contain
2630 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2632 ptr = ehdrC + shdr[i].sh_offset;
2639 #if defined(ia64_HOST_ARCH)
2641 findElfSegment ( void* objImage, Elf_Addr vaddr )
2643 char* ehdrC = (char*)objImage;
2644 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2645 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2646 Elf_Addr segaddr = 0;
2649 for (i = 0; i < ehdr->e_phnum; i++) {
2650 segaddr = phdr[i].p_vaddr;
2651 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2659 ocVerifyImage_ELF ( ObjectCode* oc )
2663 int i, j, nent, nstrtab, nsymtabs;
2667 char* ehdrC = (char*)(oc->image);
2668 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2670 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2671 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2672 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2673 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2674 errorBelch("%s: not an ELF object", oc->fileName);
2678 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2679 errorBelch("%s: unsupported ELF format", oc->fileName);
2683 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2684 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2686 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2687 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2689 errorBelch("%s: unknown endiannness", oc->fileName);
2693 if (ehdr->e_type != ET_REL) {
2694 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2697 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2699 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2700 switch (ehdr->e_machine) {
2701 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2702 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2704 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2706 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2708 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2710 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2711 errorBelch("%s: unknown architecture", oc->fileName);
2715 IF_DEBUG(linker,debugBelch(
2716 "\nSection header table: start %d, n_entries %d, ent_size %d\n",
2717 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2719 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2721 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2723 if (ehdr->e_shstrndx == SHN_UNDEF) {
2724 errorBelch("%s: no section header string table", oc->fileName);
2727 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2729 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2732 for (i = 0; i < ehdr->e_shnum; i++) {
2733 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2734 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2735 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2736 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2737 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2738 ehdrC + shdr[i].sh_offset,
2739 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2741 if (shdr[i].sh_type == SHT_REL) {
2742 IF_DEBUG(linker,debugBelch("Rel " ));
2743 } else if (shdr[i].sh_type == SHT_RELA) {
2744 IF_DEBUG(linker,debugBelch("RelA " ));
2746 IF_DEBUG(linker,debugBelch(" "));
2749 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2753 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2756 for (i = 0; i < ehdr->e_shnum; i++) {
2757 if (shdr[i].sh_type == SHT_STRTAB
2758 /* Ignore the section header's string table. */
2759 && i != ehdr->e_shstrndx
2760 /* Ignore string tables named .stabstr, as they contain
2762 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2764 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2765 strtab = ehdrC + shdr[i].sh_offset;
2770 errorBelch("%s: no string tables, or too many", oc->fileName);
2775 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2776 for (i = 0; i < ehdr->e_shnum; i++) {
2777 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2778 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2780 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2781 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2782 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)\n",
2784 shdr[i].sh_size % sizeof(Elf_Sym)
2786 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2787 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2790 for (j = 0; j < nent; j++) {
2791 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2792 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2793 (int)stab[j].st_shndx,
2794 (int)stab[j].st_size,
2795 (char*)stab[j].st_value ));
2797 IF_DEBUG(linker,debugBelch("type=" ));
2798 switch (ELF_ST_TYPE(stab[j].st_info)) {
2799 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2800 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2801 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2802 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2803 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2804 default: IF_DEBUG(linker,debugBelch("? " )); break;
2806 IF_DEBUG(linker,debugBelch(" " ));
2808 IF_DEBUG(linker,debugBelch("bind=" ));
2809 switch (ELF_ST_BIND(stab[j].st_info)) {
2810 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2811 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2812 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2813 default: IF_DEBUG(linker,debugBelch("? " )); break;
2815 IF_DEBUG(linker,debugBelch(" " ));
2817 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2821 if (nsymtabs == 0) {
2822 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2829 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2833 if (hdr->sh_type == SHT_PROGBITS
2834 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2835 /* .text-style section */
2836 return SECTIONKIND_CODE_OR_RODATA;
2839 if (hdr->sh_type == SHT_PROGBITS
2840 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2841 /* .data-style section */
2842 return SECTIONKIND_RWDATA;
2845 if (hdr->sh_type == SHT_PROGBITS
2846 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2847 /* .rodata-style section */
2848 return SECTIONKIND_CODE_OR_RODATA;
2851 if (hdr->sh_type == SHT_NOBITS
2852 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2853 /* .bss-style section */
2855 return SECTIONKIND_RWDATA;
2858 return SECTIONKIND_OTHER;
2863 ocGetNames_ELF ( ObjectCode* oc )
2868 char* ehdrC = (char*)(oc->image);
2869 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2870 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2871 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2873 ASSERT(symhash != NULL);
2876 errorBelch("%s: no strtab", oc->fileName);
2881 for (i = 0; i < ehdr->e_shnum; i++) {
2882 /* Figure out what kind of section it is. Logic derived from
2883 Figure 1.14 ("Special Sections") of the ELF document
2884 ("Portable Formats Specification, Version 1.1"). */
2886 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2888 if (is_bss && shdr[i].sh_size > 0) {
2889 /* This is a non-empty .bss section. Allocate zeroed space for
2890 it, and set its .sh_offset field such that
2891 ehdrC + .sh_offset == addr_of_zeroed_space. */
2892 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2893 "ocGetNames_ELF(BSS)");
2894 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2896 debugBelch("BSS section at 0x%x, size %d\n",
2897 zspace, shdr[i].sh_size);
2901 /* fill in the section info */
2902 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2903 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2904 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2905 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2908 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2910 /* copy stuff into this module's object symbol table */
2911 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2912 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2914 oc->n_symbols = nent;
2915 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2916 "ocGetNames_ELF(oc->symbols)");
2918 for (j = 0; j < nent; j++) {
2920 char isLocal = FALSE; /* avoids uninit-var warning */
2922 char* nm = strtab + stab[j].st_name;
2923 int secno = stab[j].st_shndx;
2925 /* Figure out if we want to add it; if so, set ad to its
2926 address. Otherwise leave ad == NULL. */
2928 if (secno == SHN_COMMON) {
2930 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2932 debugBelch("COMMON symbol, size %d name %s\n",
2933 stab[j].st_size, nm);
2935 /* Pointless to do addProddableBlock() for this area,
2936 since the linker should never poke around in it. */
2939 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2940 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2942 /* and not an undefined symbol */
2943 && stab[j].st_shndx != SHN_UNDEF
2944 /* and not in a "special section" */
2945 && stab[j].st_shndx < SHN_LORESERVE
2947 /* and it's a not a section or string table or anything silly */
2948 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2949 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2950 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2953 /* Section 0 is the undefined section, hence > and not >=. */
2954 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2956 if (shdr[secno].sh_type == SHT_NOBITS) {
2957 debugBelch(" BSS symbol, size %d off %d name %s\n",
2958 stab[j].st_size, stab[j].st_value, nm);
2961 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2962 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2965 #ifdef ELF_FUNCTION_DESC
2966 /* dlsym() and the initialisation table both give us function
2967 * descriptors, so to be consistent we store function descriptors
2968 * in the symbol table */
2969 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2970 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2972 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
2973 ad, oc->fileName, nm ));
2978 /* And the decision is ... */
2982 oc->symbols[j] = nm;
2985 /* Ignore entirely. */
2987 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2991 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
2992 strtab + stab[j].st_name ));
2995 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2996 (int)ELF_ST_BIND(stab[j].st_info),
2997 (int)ELF_ST_TYPE(stab[j].st_info),
2998 (int)stab[j].st_shndx,
2999 strtab + stab[j].st_name
3002 oc->symbols[j] = NULL;
3011 /* Do ELF relocations which lack an explicit addend. All x86-linux
3012 relocations appear to be of this form. */
3014 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3015 Elf_Shdr* shdr, int shnum,
3016 Elf_Sym* stab, char* strtab )
3021 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3022 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3023 int target_shndx = shdr[shnum].sh_info;
3024 int symtab_shndx = shdr[shnum].sh_link;
3026 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3027 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3028 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3029 target_shndx, symtab_shndx ));
3031 /* Skip sections that we're not interested in. */
3034 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3035 if (kind == SECTIONKIND_OTHER) {
3036 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3041 for (j = 0; j < nent; j++) {
3042 Elf_Addr offset = rtab[j].r_offset;
3043 Elf_Addr info = rtab[j].r_info;
3045 Elf_Addr P = ((Elf_Addr)targ) + offset;
3046 Elf_Word* pP = (Elf_Word*)P;
3052 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3053 j, (void*)offset, (void*)info ));
3055 IF_DEBUG(linker,debugBelch( " ZERO" ));
3058 Elf_Sym sym = stab[ELF_R_SYM(info)];
3059 /* First see if it is a local symbol. */
3060 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3061 /* Yes, so we can get the address directly from the ELF symbol
3063 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3065 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3066 + stab[ELF_R_SYM(info)].st_value);
3069 /* No, so look up the name in our global table. */
3070 symbol = strtab + sym.st_name;
3071 S_tmp = lookupSymbol( symbol );
3072 S = (Elf_Addr)S_tmp;
3075 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3078 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3081 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3082 (void*)P, (void*)S, (void*)A ));
3083 checkProddableBlock ( oc, pP );
3087 switch (ELF_R_TYPE(info)) {
3088 # ifdef i386_HOST_ARCH
3089 case R_386_32: *pP = value; break;
3090 case R_386_PC32: *pP = value - P; break;
3093 errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
3094 oc->fileName, ELF_R_TYPE(info));
3102 /* Do ELF relocations for which explicit addends are supplied.
3103 sparc-solaris relocations appear to be of this form. */
3105 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3106 Elf_Shdr* shdr, int shnum,
3107 Elf_Sym* stab, char* strtab )
3112 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3113 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3114 int target_shndx = shdr[shnum].sh_info;
3115 int symtab_shndx = shdr[shnum].sh_link;
3117 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3118 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3119 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3120 target_shndx, symtab_shndx ));
3122 for (j = 0; j < nent; j++) {
3123 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3124 /* This #ifdef only serves to avoid unused-var warnings. */
3125 Elf_Addr offset = rtab[j].r_offset;
3126 Elf_Addr P = targ + offset;
3128 Elf_Addr info = rtab[j].r_info;
3129 Elf_Addr A = rtab[j].r_addend;
3133 # if defined(sparc_HOST_ARCH)
3134 Elf_Word* pP = (Elf_Word*)P;
3136 # elif defined(ia64_HOST_ARCH)
3137 Elf64_Xword *pP = (Elf64_Xword *)P;
3139 # elif defined(powerpc_HOST_ARCH)
3143 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3144 j, (void*)offset, (void*)info,
3147 IF_DEBUG(linker,debugBelch( " ZERO" ));
3150 Elf_Sym sym = stab[ELF_R_SYM(info)];
3151 /* First see if it is a local symbol. */
3152 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3153 /* Yes, so we can get the address directly from the ELF symbol
3155 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3157 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3158 + stab[ELF_R_SYM(info)].st_value);
3159 #ifdef ELF_FUNCTION_DESC
3160 /* Make a function descriptor for this function */
3161 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3162 S = allocateFunctionDesc(S + A);
3167 /* No, so look up the name in our global table. */
3168 symbol = strtab + sym.st_name;
3169 S_tmp = lookupSymbol( symbol );
3170 S = (Elf_Addr)S_tmp;
3172 #ifdef ELF_FUNCTION_DESC
3173 /* If a function, already a function descriptor - we would
3174 have to copy it to add an offset. */
3175 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3176 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3180 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3183 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3186 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3187 (void*)P, (void*)S, (void*)A ));
3188 /* checkProddableBlock ( oc, (void*)P ); */
3192 switch (ELF_R_TYPE(info)) {
3193 # if defined(sparc_HOST_ARCH)
3194 case R_SPARC_WDISP30:
3195 w1 = *pP & 0xC0000000;
3196 w2 = (Elf_Word)((value - P) >> 2);
3197 ASSERT((w2 & 0xC0000000) == 0);
3202 w1 = *pP & 0xFFC00000;
3203 w2 = (Elf_Word)(value >> 10);
3204 ASSERT((w2 & 0xFFC00000) == 0);
3210 w2 = (Elf_Word)(value & 0x3FF);
3211 ASSERT((w2 & ~0x3FF) == 0);
3215 /* According to the Sun documentation:
3217 This relocation type resembles R_SPARC_32, except it refers to an
3218 unaligned word. That is, the word to be relocated must be treated
3219 as four separate bytes with arbitrary alignment, not as a word
3220 aligned according to the architecture requirements.
3222 (JRS: which means that freeloading on the R_SPARC_32 case
3223 is probably wrong, but hey ...)
3227 w2 = (Elf_Word)value;
3230 # elif defined(ia64_HOST_ARCH)
3231 case R_IA64_DIR64LSB:
3232 case R_IA64_FPTR64LSB:
3235 case R_IA64_PCREL64LSB:
3238 case R_IA64_SEGREL64LSB:
3239 addr = findElfSegment(ehdrC, value);
3242 case R_IA64_GPREL22:
3243 ia64_reloc_gprel22(P, value);
3245 case R_IA64_LTOFF22:
3246 case R_IA64_LTOFF22X:
3247 case R_IA64_LTOFF_FPTR22:
3248 addr = allocateGOTEntry(value);
3249 ia64_reloc_gprel22(P, addr);
3251 case R_IA64_PCREL21B:
3252 ia64_reloc_pcrel21(P, S, oc);
3255 /* This goes with R_IA64_LTOFF22X and points to the load to
3256 * convert into a move. We don't implement relaxation. */
3258 # elif defined(powerpc_HOST_ARCH)
3259 case R_PPC_ADDR16_LO:
3260 *(Elf32_Half*) P = value;
3263 case R_PPC_ADDR16_HI:
3264 *(Elf32_Half*) P = value >> 16;
3267 case R_PPC_ADDR16_HA:
3268 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3272 *(Elf32_Word *) P = value;
3276 *(Elf32_Word *) P = value - P;
3282 if( delta << 6 >> 6 != delta )
3284 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3287 if( value == 0 || delta << 6 >> 6 != delta )
3289 barf( "Unable to make ppcJumpIsland for #%d",
3295 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3296 | (delta & 0x3fffffc);
3300 #if x86_64_HOST_ARCH
3302 *(Elf64_Xword *)P = value;
3307 StgInt64 off = value - P;
3308 if (off >= 0x7fffffffL || off < -0x80000000L) {
3309 barf("R_X86_64_PC32 relocation out of range: %s = %p",
3312 *(Elf64_Word *)P = (Elf64_Word)off;
3317 if (value >= 0x7fffffffL) {
3318 barf("R_X86_64_32 relocation out of range: %s = %p\n",
3321 *(Elf64_Word *)P = (Elf64_Word)value;
3325 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3326 barf("R_X86_64_32S relocation out of range: %s = %p\n",
3329 *(Elf64_Sword *)P = (Elf64_Sword)value;
3334 errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
3335 oc->fileName, ELF_R_TYPE(info));
3344 ocResolve_ELF ( ObjectCode* oc )
3348 Elf_Sym* stab = NULL;
3349 char* ehdrC = (char*)(oc->image);
3350 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3351 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3353 /* first find "the" symbol table */
3354 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3356 /* also go find the string table */
3357 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3359 if (stab == NULL || strtab == NULL) {
3360 errorBelch("%s: can't find string or symbol table", oc->fileName);
3364 /* Process the relocation sections. */
3365 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3366 if (shdr[shnum].sh_type == SHT_REL) {
3367 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3368 shnum, stab, strtab );
3372 if (shdr[shnum].sh_type == SHT_RELA) {
3373 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3374 shnum, stab, strtab );
3379 /* Free the local symbol table; we won't need it again. */
3380 freeHashTable(oc->lochash, NULL);
3383 #if defined(powerpc_HOST_ARCH)
3384 ocFlushInstructionCache( oc );
3392 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3393 * at the front. The following utility functions pack and unpack instructions, and
3394 * take care of the most common relocations.
3397 #ifdef ia64_HOST_ARCH
3400 ia64_extract_instruction(Elf64_Xword *target)
3403 int slot = (Elf_Addr)target & 3;
3404 target = (Elf_Addr)target & ~3;
3412 return ((w1 >> 5) & 0x1ffffffffff);
3414 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3418 barf("ia64_extract_instruction: invalid slot %p", target);
3423 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3425 int slot = (Elf_Addr)target & 3;
3426 target = (Elf_Addr)target & ~3;
3431 *target |= value << 5;
3434 *target |= value << 46;
3435 *(target+1) |= value >> 18;
3438 *(target+1) |= value << 23;
3444 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3446 Elf64_Xword instruction;
3447 Elf64_Sxword rel_value;
3449 rel_value = value - gp_val;
3450 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3451 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3453 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3454 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3455 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3456 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3457 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3458 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3462 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3464 Elf64_Xword instruction;
3465 Elf64_Sxword rel_value;
3468 entry = allocatePLTEntry(value, oc);
3470 rel_value = (entry >> 4) - (target >> 4);
3471 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3472 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3474 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3475 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3476 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3477 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3483 * PowerPC ELF specifics
3486 #ifdef powerpc_HOST_ARCH
3488 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3494 ehdr = (Elf_Ehdr *) oc->image;
3495 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3497 for( i = 0; i < ehdr->e_shnum; i++ )
3498 if( shdr[i].sh_type == SHT_SYMTAB )
3501 if( i == ehdr->e_shnum )
3503 errorBelch( "This ELF file contains no symtab" );
3507 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3509 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3510 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3515 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3518 #endif /* powerpc */
3522 /* --------------------------------------------------------------------------
3524 * ------------------------------------------------------------------------*/
3526 #if defined(OBJFORMAT_MACHO)
3529 Support for MachO linking on Darwin/MacOS X
3530 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3532 I hereby formally apologize for the hackish nature of this code.
3533 Things that need to be done:
3534 *) implement ocVerifyImage_MachO
3535 *) add still more sanity checks.
3538 #ifdef powerpc_HOST_ARCH
3539 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3541 struct mach_header *header = (struct mach_header *) oc->image;
3542 struct load_command *lc = (struct load_command *) (header + 1);
3545 for( i = 0; i < header->ncmds; i++ )
3547 if( lc->cmd == LC_SYMTAB )
3549 // Find out the first and last undefined external
3550 // symbol, so we don't have to allocate too many
3552 struct symtab_command *symLC = (struct symtab_command *) lc;
3553 unsigned min = symLC->nsyms, max = 0;
3554 struct nlist *nlist =
3555 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3557 for(i=0;i<symLC->nsyms;i++)
3559 if(nlist[i].n_type & N_STAB)
3561 else if(nlist[i].n_type & N_EXT)
3563 if((nlist[i].n_type & N_TYPE) == N_UNDF
3564 && (nlist[i].n_value == 0))
3574 return ocAllocateJumpIslands(oc, max - min + 1, min);
3579 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3581 return ocAllocateJumpIslands(oc,0,0);
3585 static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
3587 // FIXME: do some verifying here
3591 static int resolveImports(
3594 struct symtab_command *symLC,
3595 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3596 unsigned long *indirectSyms,
3597 struct nlist *nlist)
3601 for(i=0;i*4<sect->size;i++)
3603 // according to otool, reserved1 contains the first index into the indirect symbol table
3604 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3605 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3608 if((symbol->n_type & N_TYPE) == N_UNDF
3609 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3610 addr = (void*) (symbol->n_value);
3611 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3614 addr = lookupSymbol(nm);
3617 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3621 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3622 ((void**)(image + sect->offset))[i] = addr;
3628 static unsigned long relocateAddress(
3631 struct section* sections,
3632 unsigned long address)
3635 for(i = 0; i < nSections; i++)
3637 if(sections[i].addr <= address
3638 && address < sections[i].addr + sections[i].size)
3640 return (unsigned long)oc->image
3641 + sections[i].offset + address - sections[i].addr;
3644 barf("Invalid Mach-O file:"
3645 "Address out of bounds while relocating object file");
3649 static int relocateSection(
3652 struct symtab_command *symLC, struct nlist *nlist,
3653 int nSections, struct section* sections, struct section *sect)
3655 struct relocation_info *relocs;
3658 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3660 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3662 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
3664 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
3668 relocs = (struct relocation_info*) (image + sect->reloff);
3672 if(relocs[i].r_address & R_SCATTERED)
3674 struct scattered_relocation_info *scat =
3675 (struct scattered_relocation_info*) &relocs[i];
3679 if(scat->r_length == 2)
3681 unsigned long word = 0;
3682 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3683 checkProddableBlock(oc,wordPtr);
3685 // Note on relocation types:
3686 // i386 uses the GENERIC_RELOC_* types,
3687 // while ppc uses special PPC_RELOC_* types.
3688 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
3689 // in both cases, all others are different.
3690 // Therefore, we use GENERIC_RELOC_VANILLA
3691 // and GENERIC_RELOC_PAIR instead of the PPC variants,
3692 // and use #ifdefs for the other types.
3694 // Step 1: Figure out what the relocated value should be
3695 if(scat->r_type == GENERIC_RELOC_VANILLA)
3697 word = *wordPtr + (unsigned long) relocateAddress(
3704 #ifdef powerpc_HOST_ARCH
3705 else if(scat->r_type == PPC_RELOC_SECTDIFF
3706 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3707 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3708 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3710 else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
3713 struct scattered_relocation_info *pair =
3714 (struct scattered_relocation_info*) &relocs[i+1];
3716 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
3717 barf("Invalid Mach-O file: "
3718 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
3720 word = (unsigned long)
3721 (relocateAddress(oc, nSections, sections, scat->r_value)
3722 - relocateAddress(oc, nSections, sections, pair->r_value));
3725 #ifdef powerpc_HOST_ARCH
3726 else if(scat->r_type == PPC_RELOC_HI16
3727 || scat->r_type == PPC_RELOC_LO16
3728 || scat->r_type == PPC_RELOC_HA16
3729 || scat->r_type == PPC_RELOC_LO14)
3730 { // these are generated by label+offset things
3731 struct relocation_info *pair = &relocs[i+1];
3732 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3733 barf("Invalid Mach-O file: "
3734 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3736 if(scat->r_type == PPC_RELOC_LO16)
3738 word = ((unsigned short*) wordPtr)[1];
3739 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3741 else if(scat->r_type == PPC_RELOC_LO14)
3743 barf("Unsupported Relocation: PPC_RELOC_LO14");
3744 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3745 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3747 else if(scat->r_type == PPC_RELOC_HI16)
3749 word = ((unsigned short*) wordPtr)[1] << 16;
3750 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3752 else if(scat->r_type == PPC_RELOC_HA16)
3754 word = ((unsigned short*) wordPtr)[1] << 16;
3755 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3759 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3766 continue; // ignore the others
3768 #ifdef powerpc_HOST_ARCH
3769 if(scat->r_type == GENERIC_RELOC_VANILLA
3770 || scat->r_type == PPC_RELOC_SECTDIFF)
3772 if(scat->r_type == GENERIC_RELOC_VANILLA
3773 || scat->r_type == GENERIC_RELOC_SECTDIFF)
3778 #ifdef powerpc_HOST_ARCH
3779 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3781 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3783 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3785 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3787 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3789 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3790 + ((word & (1<<15)) ? 1 : 0);
3796 continue; // FIXME: I hope it's OK to ignore all the others.
3800 struct relocation_info *reloc = &relocs[i];
3801 if(reloc->r_pcrel && !reloc->r_extern)
3804 if(reloc->r_length == 2)
3806 unsigned long word = 0;
3807 #ifdef powerpc_HOST_ARCH
3808 unsigned long jumpIsland = 0;
3809 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
3810 // to avoid warning and to catch
3814 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3815 checkProddableBlock(oc,wordPtr);
3817 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3821 #ifdef powerpc_HOST_ARCH
3822 else if(reloc->r_type == PPC_RELOC_LO16)
3824 word = ((unsigned short*) wordPtr)[1];
3825 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3827 else if(reloc->r_type == PPC_RELOC_HI16)
3829 word = ((unsigned short*) wordPtr)[1] << 16;
3830 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3832 else if(reloc->r_type == PPC_RELOC_HA16)
3834 word = ((unsigned short*) wordPtr)[1] << 16;
3835 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3837 else if(reloc->r_type == PPC_RELOC_BR24)
3840 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3844 if(!reloc->r_extern)
3847 sections[reloc->r_symbolnum-1].offset
3848 - sections[reloc->r_symbolnum-1].addr
3855 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3856 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3857 void *symbolAddress = lookupSymbol(nm);
3860 errorBelch("\nunknown symbol `%s'", nm);
3866 #ifdef powerpc_HOST_ARCH
3867 // In the .o file, this should be a relative jump to NULL
3868 // and we'll change it to a relative jump to the symbol
3869 ASSERT(-word == reloc->r_address);
3870 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress);
3873 offsetToJumpIsland = word + jumpIsland
3874 - (((long)image) + sect->offset - sect->addr);
3877 word += (unsigned long) symbolAddress
3878 - (((long)image) + sect->offset - sect->addr);
3882 word += (unsigned long) symbolAddress;
3886 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3891 #ifdef powerpc_HOST_ARCH
3892 else if(reloc->r_type == PPC_RELOC_LO16)
3894 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3897 else if(reloc->r_type == PPC_RELOC_HI16)
3899 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3902 else if(reloc->r_type == PPC_RELOC_HA16)
3904 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3905 + ((word & (1<<15)) ? 1 : 0);
3908 else if(reloc->r_type == PPC_RELOC_BR24)
3910 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3912 // The branch offset is too large.
3913 // Therefore, we try to use a jump island.
3916 barf("unconditional relative branch out of range: "
3917 "no jump island available");
3920 word = offsetToJumpIsland;
3921 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3922 barf("unconditional relative branch out of range: "
3923 "jump island out of range");
3925 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3930 barf("\nunknown relocation %d",reloc->r_type);
3937 static int ocGetNames_MachO(ObjectCode* oc)
3939 char *image = (char*) oc->image;
3940 struct mach_header *header = (struct mach_header*) image;
3941 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3942 unsigned i,curSymbol = 0;
3943 struct segment_command *segLC = NULL;
3944 struct section *sections;
3945 struct symtab_command *symLC = NULL;
3946 struct nlist *nlist;
3947 unsigned long commonSize = 0;
3948 char *commonStorage = NULL;
3949 unsigned long commonCounter;
3951 for(i=0;i<header->ncmds;i++)
3953 if(lc->cmd == LC_SEGMENT)
3954 segLC = (struct segment_command*) lc;
3955 else if(lc->cmd == LC_SYMTAB)
3956 symLC = (struct symtab_command*) lc;
3957 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3960 sections = (struct section*) (segLC+1);
3961 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
3964 for(i=0;i<segLC->nsects;i++)
3966 if(sections[i].size == 0)
3969 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3971 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3972 "ocGetNames_MachO(common symbols)");
3973 sections[i].offset = zeroFillArea - image;
3976 if(!strcmp(sections[i].sectname,"__text"))
3977 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3978 (void*) (image + sections[i].offset),
3979 (void*) (image + sections[i].offset + sections[i].size));
3980 else if(!strcmp(sections[i].sectname,"__const"))
3981 addSection(oc, SECTIONKIND_RWDATA,
3982 (void*) (image + sections[i].offset),
3983 (void*) (image + sections[i].offset + sections[i].size));
3984 else if(!strcmp(sections[i].sectname,"__data"))
3985 addSection(oc, SECTIONKIND_RWDATA,
3986 (void*) (image + sections[i].offset),
3987 (void*) (image + sections[i].offset + sections[i].size));
3988 else if(!strcmp(sections[i].sectname,"__bss")
3989 || !strcmp(sections[i].sectname,"__common"))
3990 addSection(oc, SECTIONKIND_RWDATA,
3991 (void*) (image + sections[i].offset),
3992 (void*) (image + sections[i].offset + sections[i].size));
3994 addProddableBlock(oc, (void*) (image + sections[i].offset),
3998 // count external symbols defined here
4002 for(i=0;i<symLC->nsyms;i++)
4004 if(nlist[i].n_type & N_STAB)
4006 else if(nlist[i].n_type & N_EXT)
4008 if((nlist[i].n_type & N_TYPE) == N_UNDF
4009 && (nlist[i].n_value != 0))
4011 commonSize += nlist[i].n_value;
4014 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4019 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4020 "ocGetNames_MachO(oc->symbols)");
4024 for(i=0;i<symLC->nsyms;i++)
4026 if(nlist[i].n_type & N_STAB)
4028 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4030 if(nlist[i].n_type & N_EXT)
4032 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4033 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4035 + sections[nlist[i].n_sect-1].offset
4036 - sections[nlist[i].n_sect-1].addr
4037 + nlist[i].n_value);
4038 oc->symbols[curSymbol++] = nm;
4042 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4043 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
4045 + sections[nlist[i].n_sect-1].offset
4046 - sections[nlist[i].n_sect-1].addr
4047 + nlist[i].n_value);
4053 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4054 commonCounter = (unsigned long)commonStorage;
4057 for(i=0;i<symLC->nsyms;i++)
4059 if((nlist[i].n_type & N_TYPE) == N_UNDF
4060 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4062 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4063 unsigned long sz = nlist[i].n_value;
4065 nlist[i].n_value = commonCounter;
4067 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4068 (void*)commonCounter);
4069 oc->symbols[curSymbol++] = nm;
4071 commonCounter += sz;
4078 static int ocResolve_MachO(ObjectCode* oc)
4080 char *image = (char*) oc->image;
4081 struct mach_header *header = (struct mach_header*) image;
4082 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4084 struct segment_command *segLC = NULL;
4085 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
4086 struct symtab_command *symLC = NULL;
4087 struct dysymtab_command *dsymLC = NULL;
4088 struct nlist *nlist;
4090 for(i=0;i<header->ncmds;i++)
4092 if(lc->cmd == LC_SEGMENT)
4093 segLC = (struct segment_command*) lc;
4094 else if(lc->cmd == LC_SYMTAB)
4095 symLC = (struct symtab_command*) lc;
4096 else if(lc->cmd == LC_DYSYMTAB)
4097 dsymLC = (struct dysymtab_command*) lc;
4098 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4101 sections = (struct section*) (segLC+1);
4102 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4105 for(i=0;i<segLC->nsects;i++)
4107 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
4108 la_ptrs = §ions[i];
4109 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
4110 nl_ptrs = §ions[i];
4111 else if(!strcmp(sections[i].sectname,"__la_sym_ptr2"))
4112 la_ptrs = §ions[i];
4113 else if(!strcmp(sections[i].sectname,"__la_sym_ptr3"))
4114 la_ptrs = §ions[i];
4119 unsigned long *indirectSyms
4120 = (unsigned long*) (image + dsymLC->indirectsymoff);
4123 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
4126 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
4130 for(i=0;i<segLC->nsects;i++)
4132 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
4136 /* Free the local symbol table; we won't need it again. */
4137 freeHashTable(oc->lochash, NULL);
4140 #if defined (powerpc_HOST_ARCH)
4141 ocFlushInstructionCache( oc );
4147 #ifdef powerpc_HOST_ARCH
4149 * The Mach-O object format uses leading underscores. But not everywhere.
4150 * There is a small number of runtime support functions defined in
4151 * libcc_dynamic.a whose name does not have a leading underscore.
4152 * As a consequence, we can't get their address from C code.
4153 * We have to use inline assembler just to take the address of a function.
4157 static void machoInitSymbolsWithoutUnderscore()
4159 extern void* symbolsWithoutUnderscore[];
4160 void **p = symbolsWithoutUnderscore;
4161 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4165 __asm__ volatile(".long " # x);
4167 RTS_MACHO_NOUNDERLINE_SYMBOLS
4169 __asm__ volatile(".text");
4173 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4175 RTS_MACHO_NOUNDERLINE_SYMBOLS
4182 * Figure out by how much to shift the entire Mach-O file in memory
4183 * when loading so that its single segment ends up 16-byte-aligned
4185 static int machoGetMisalignment( FILE * f )
4187 struct mach_header header;
4190 fread(&header, sizeof(header), 1, f);
4193 if(header.magic != MH_MAGIC)
4196 misalignment = (header.sizeofcmds + sizeof(header))
4199 return misalignment ? (16 - misalignment) : 0;