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"
31 #ifdef HAVE_SYS_TYPES_H
32 #include <sys/types.h>
38 #ifdef HAVE_SYS_STAT_H
42 #if defined(HAVE_DLFCN_H)
46 #if defined(cygwin32_HOST_OS)
51 #ifdef HAVE_SYS_TIME_H
55 #include <sys/fcntl.h>
56 #include <sys/termios.h>
57 #include <sys/utime.h>
58 #include <sys/utsname.h>
62 #if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
67 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
75 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
76 # define OBJFORMAT_ELF
77 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
78 # define OBJFORMAT_PEi386
81 #elif defined(darwin_HOST_OS)
82 # define OBJFORMAT_MACHO
83 # include <mach-o/loader.h>
84 # include <mach-o/nlist.h>
85 # include <mach-o/reloc.h>
86 # include <mach-o/dyld.h>
87 #if defined(powerpc_HOST_ARCH)
88 # include <mach-o/ppc/reloc.h>
92 /* Hash table mapping symbol names to Symbol */
93 static /*Str*/HashTable *symhash;
95 /* List of currently loaded objects */
96 ObjectCode *objects = NULL; /* initially empty */
98 #if defined(OBJFORMAT_ELF)
99 static int ocVerifyImage_ELF ( ObjectCode* oc );
100 static int ocGetNames_ELF ( ObjectCode* oc );
101 static int ocResolve_ELF ( ObjectCode* oc );
102 #if defined(powerpc_HOST_ARCH)
103 static int ocAllocateJumpIslands_ELF ( ObjectCode* oc );
105 #elif defined(OBJFORMAT_PEi386)
106 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
107 static int ocGetNames_PEi386 ( ObjectCode* oc );
108 static int ocResolve_PEi386 ( ObjectCode* oc );
109 #elif defined(OBJFORMAT_MACHO)
110 static int ocVerifyImage_MachO ( ObjectCode* oc );
111 static int ocGetNames_MachO ( ObjectCode* oc );
112 static int ocResolve_MachO ( ObjectCode* oc );
114 static int machoGetMisalignment( FILE * );
115 #ifdef powerpc_HOST_ARCH
116 static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
117 static void machoInitSymbolsWithoutUnderscore( void );
121 #if defined(x86_64_HOST_ARCH)
122 static void*x86_64_high_symbol( char *lbl, void *addr );
125 /* -----------------------------------------------------------------------------
126 * Built-in symbols from the RTS
129 typedef struct _RtsSymbolVal {
136 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
137 SymX(makeStableNamezh_fast) \
138 SymX(finalizzeWeakzh_fast)
140 /* These are not available in GUM!!! -- HWL */
141 #define Maybe_Stable_Names
144 #if !defined (mingw32_HOST_OS)
145 #define RTS_POSIX_ONLY_SYMBOLS \
146 SymX(signal_handlers) \
147 SymX(stg_sig_install) \
151 #if defined (cygwin32_HOST_OS)
152 #define RTS_MINGW_ONLY_SYMBOLS /**/
153 /* Don't have the ability to read import libs / archives, so
154 * we have to stupidly list a lot of what libcygwin.a
157 #define RTS_CYGWIN_ONLY_SYMBOLS \
235 #elif !defined(mingw32_HOST_OS)
236 #define RTS_MINGW_ONLY_SYMBOLS /**/
237 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
238 #else /* defined(mingw32_HOST_OS) */
239 #define RTS_POSIX_ONLY_SYMBOLS /**/
240 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
242 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
244 #define RTS_MINGW_EXTRA_SYMS \
245 Sym(_imp____mb_cur_max) \
248 #define RTS_MINGW_EXTRA_SYMS
251 /* These are statically linked from the mingw libraries into the ghc
252 executable, so we have to employ this hack. */
253 #define RTS_MINGW_ONLY_SYMBOLS \
254 SymX(asyncReadzh_fast) \
255 SymX(asyncWritezh_fast) \
256 SymX(asyncDoProczh_fast) \
268 SymX(getservbyname) \
269 SymX(getservbyport) \
270 SymX(getprotobynumber) \
271 SymX(getprotobyname) \
272 SymX(gethostbyname) \
273 SymX(gethostbyaddr) \
307 SymX(rts_InstallConsoleEvent) \
308 SymX(rts_ConsoleHandlerDone) \
310 Sym(_imp___timezone) \
319 RTS_MINGW_EXTRA_SYMS \
323 #if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
324 #define RTS_DARWIN_ONLY_SYMBOLS \
325 Sym(asprintf$LDBLStub) \
329 Sym(fprintf$LDBLStub) \
330 Sym(fscanf$LDBLStub) \
331 Sym(fwprintf$LDBLStub) \
332 Sym(fwscanf$LDBLStub) \
333 Sym(printf$LDBLStub) \
334 Sym(scanf$LDBLStub) \
335 Sym(snprintf$LDBLStub) \
336 Sym(sprintf$LDBLStub) \
337 Sym(sscanf$LDBLStub) \
338 Sym(strtold$LDBLStub) \
339 Sym(swprintf$LDBLStub) \
340 Sym(swscanf$LDBLStub) \
341 Sym(syslog$LDBLStub) \
342 Sym(vasprintf$LDBLStub) \
344 Sym(verrc$LDBLStub) \
345 Sym(verrx$LDBLStub) \
346 Sym(vfprintf$LDBLStub) \
347 Sym(vfscanf$LDBLStub) \
348 Sym(vfwprintf$LDBLStub) \
349 Sym(vfwscanf$LDBLStub) \
350 Sym(vprintf$LDBLStub) \
351 Sym(vscanf$LDBLStub) \
352 Sym(vsnprintf$LDBLStub) \
353 Sym(vsprintf$LDBLStub) \
354 Sym(vsscanf$LDBLStub) \
355 Sym(vswprintf$LDBLStub) \
356 Sym(vswscanf$LDBLStub) \
357 Sym(vsyslog$LDBLStub) \
358 Sym(vwarn$LDBLStub) \
359 Sym(vwarnc$LDBLStub) \
360 Sym(vwarnx$LDBLStub) \
361 Sym(vwprintf$LDBLStub) \
362 Sym(vwscanf$LDBLStub) \
364 Sym(warnc$LDBLStub) \
365 Sym(warnx$LDBLStub) \
366 Sym(wcstold$LDBLStub) \
367 Sym(wprintf$LDBLStub) \
370 #define RTS_DARWIN_ONLY_SYMBOLS
374 # define MAIN_CAP_SYM SymX(MainCapability)
376 # define MAIN_CAP_SYM
379 #if !defined(mingw32_HOST_OS)
380 #define RTS_USER_SIGNALS_SYMBOLS \
381 SymX(setIOManagerPipe)
383 #define RTS_USER_SIGNALS_SYMBOLS /* nothing */
386 #ifdef TABLES_NEXT_TO_CODE
387 #define RTS_RET_SYMBOLS /* nothing */
389 #define RTS_RET_SYMBOLS \
390 SymX(stg_enter_ret) \
391 SymX(stg_gc_fun_ret) \
399 SymX(stg_ap_pv_ret) \
400 SymX(stg_ap_pp_ret) \
401 SymX(stg_ap_ppv_ret) \
402 SymX(stg_ap_ppp_ret) \
403 SymX(stg_ap_pppv_ret) \
404 SymX(stg_ap_pppp_ret) \
405 SymX(stg_ap_ppppp_ret) \
406 SymX(stg_ap_pppppp_ret)
409 #define RTS_SYMBOLS \
412 SymX(stg_enter_info) \
413 SymX(stg_gc_void_info) \
414 SymX(__stg_gc_enter_1) \
415 SymX(stg_gc_noregs) \
416 SymX(stg_gc_unpt_r1_info) \
417 SymX(stg_gc_unpt_r1) \
418 SymX(stg_gc_unbx_r1_info) \
419 SymX(stg_gc_unbx_r1) \
420 SymX(stg_gc_f1_info) \
422 SymX(stg_gc_d1_info) \
424 SymX(stg_gc_l1_info) \
427 SymX(stg_gc_fun_info) \
429 SymX(stg_gc_gen_info) \
430 SymX(stg_gc_gen_hp) \
432 SymX(stg_gen_yield) \
433 SymX(stg_yield_noregs) \
434 SymX(stg_yield_to_interpreter) \
435 SymX(stg_gen_block) \
436 SymX(stg_block_noregs) \
438 SymX(stg_block_takemvar) \
439 SymX(stg_block_putmvar) \
440 SymX(stg_seq_frame_info) \
442 SymX(MallocFailHook) \
444 SymX(OutOfHeapHook) \
445 SymX(StackOverflowHook) \
446 SymX(__encodeDouble) \
447 SymX(__encodeFloat) \
451 SymX(__gmpz_cmp_si) \
452 SymX(__gmpz_cmp_ui) \
453 SymX(__gmpz_get_si) \
454 SymX(__gmpz_get_ui) \
455 SymX(__int_encodeDouble) \
456 SymX(__int_encodeFloat) \
457 SymX(andIntegerzh_fast) \
458 SymX(atomicallyzh_fast) \
462 SymX(blockAsyncExceptionszh_fast) \
464 SymX(catchRetryzh_fast) \
465 SymX(catchSTMzh_fast) \
466 SymX(closure_flags) \
468 SymX(cmpIntegerzh_fast) \
469 SymX(cmpIntegerIntzh_fast) \
470 SymX(complementIntegerzh_fast) \
471 SymX(createAdjustor) \
472 SymX(decodeDoublezh_fast) \
473 SymX(decodeFloatzh_fast) \
476 SymX(deRefWeakzh_fast) \
477 SymX(deRefStablePtrzh_fast) \
478 SymX(dirty_MUT_VAR) \
479 SymX(divExactIntegerzh_fast) \
480 SymX(divModIntegerzh_fast) \
483 SymX(forkOS_createThread) \
484 SymX(freeHaskellFunctionPtr) \
485 SymX(freeStablePtr) \
486 SymX(gcdIntegerzh_fast) \
487 SymX(gcdIntegerIntzh_fast) \
488 SymX(gcdIntzh_fast) \
497 SymX(hs_perform_gc) \
498 SymX(hs_free_stable_ptr) \
499 SymX(hs_free_fun_ptr) \
501 SymX(int2Integerzh_fast) \
502 SymX(integer2Intzh_fast) \
503 SymX(integer2Wordzh_fast) \
504 SymX(isCurrentThreadBoundzh_fast) \
505 SymX(isDoubleDenormalized) \
506 SymX(isDoubleInfinite) \
508 SymX(isDoubleNegativeZero) \
509 SymX(isEmptyMVarzh_fast) \
510 SymX(isFloatDenormalized) \
511 SymX(isFloatInfinite) \
513 SymX(isFloatNegativeZero) \
514 SymX(killThreadzh_fast) \
517 SymX(makeStablePtrzh_fast) \
518 SymX(minusIntegerzh_fast) \
519 SymX(mkApUpd0zh_fast) \
520 SymX(myThreadIdzh_fast) \
521 SymX(labelThreadzh_fast) \
522 SymX(newArrayzh_fast) \
523 SymX(newBCOzh_fast) \
524 SymX(newByteArrayzh_fast) \
525 SymX_redirect(newCAF, newDynCAF) \
526 SymX(newMVarzh_fast) \
527 SymX(newMutVarzh_fast) \
528 SymX(newTVarzh_fast) \
529 SymX(atomicModifyMutVarzh_fast) \
530 SymX(newPinnedByteArrayzh_fast) \
532 SymX(orIntegerzh_fast) \
534 SymX(performMajorGC) \
535 SymX(plusIntegerzh_fast) \
538 SymX(putMVarzh_fast) \
539 SymX(quotIntegerzh_fast) \
540 SymX(quotRemIntegerzh_fast) \
542 SymX(raiseIOzh_fast) \
543 SymX(readTVarzh_fast) \
544 SymX(remIntegerzh_fast) \
545 SymX(resetNonBlockingFd) \
550 SymX(rts_checkSchedStatus) \
553 SymX(rts_evalLazyIO) \
554 SymX(rts_evalStableIO) \
558 SymX(rts_getDouble) \
563 SymX(rts_getFunPtr) \
564 SymX(rts_getStablePtr) \
565 SymX(rts_getThreadId) \
567 SymX(rts_getWord32) \
580 SymX(rts_mkStablePtr) \
588 SymX(rtsSupportsBoundThreads) \
589 SymX(__hscore_get_saved_termios) \
590 SymX(__hscore_set_saved_termios) \
592 SymX(startupHaskell) \
593 SymX(shutdownHaskell) \
594 SymX(shutdownHaskellAndExit) \
595 SymX(stable_ptr_table) \
596 SymX(stackOverflow) \
597 SymX(stg_CAF_BLACKHOLE_info) \
598 SymX(awakenBlockedQueue) \
599 SymX(stg_CHARLIKE_closure) \
600 SymX(stg_EMPTY_MVAR_info) \
601 SymX(stg_IND_STATIC_info) \
602 SymX(stg_INTLIKE_closure) \
603 SymX(stg_MUT_ARR_PTRS_DIRTY_info) \
604 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
605 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
606 SymX(stg_WEAK_info) \
607 SymX(stg_ap_0_info) \
608 SymX(stg_ap_v_info) \
609 SymX(stg_ap_f_info) \
610 SymX(stg_ap_d_info) \
611 SymX(stg_ap_l_info) \
612 SymX(stg_ap_n_info) \
613 SymX(stg_ap_p_info) \
614 SymX(stg_ap_pv_info) \
615 SymX(stg_ap_pp_info) \
616 SymX(stg_ap_ppv_info) \
617 SymX(stg_ap_ppp_info) \
618 SymX(stg_ap_pppv_info) \
619 SymX(stg_ap_pppp_info) \
620 SymX(stg_ap_ppppp_info) \
621 SymX(stg_ap_pppppp_info) \
622 SymX(stg_ap_1_upd_info) \
623 SymX(stg_ap_2_upd_info) \
624 SymX(stg_ap_3_upd_info) \
625 SymX(stg_ap_4_upd_info) \
626 SymX(stg_ap_5_upd_info) \
627 SymX(stg_ap_6_upd_info) \
628 SymX(stg_ap_7_upd_info) \
630 SymX(stg_sel_0_upd_info) \
631 SymX(stg_sel_10_upd_info) \
632 SymX(stg_sel_11_upd_info) \
633 SymX(stg_sel_12_upd_info) \
634 SymX(stg_sel_13_upd_info) \
635 SymX(stg_sel_14_upd_info) \
636 SymX(stg_sel_15_upd_info) \
637 SymX(stg_sel_1_upd_info) \
638 SymX(stg_sel_2_upd_info) \
639 SymX(stg_sel_3_upd_info) \
640 SymX(stg_sel_4_upd_info) \
641 SymX(stg_sel_5_upd_info) \
642 SymX(stg_sel_6_upd_info) \
643 SymX(stg_sel_7_upd_info) \
644 SymX(stg_sel_8_upd_info) \
645 SymX(stg_sel_9_upd_info) \
646 SymX(stg_upd_frame_info) \
647 SymX(suspendThread) \
648 SymX(takeMVarzh_fast) \
649 SymX(timesIntegerzh_fast) \
650 SymX(tryPutMVarzh_fast) \
651 SymX(tryTakeMVarzh_fast) \
652 SymX(unblockAsyncExceptionszh_fast) \
654 SymX(unsafeThawArrayzh_fast) \
655 SymX(waitReadzh_fast) \
656 SymX(waitWritezh_fast) \
657 SymX(word2Integerzh_fast) \
658 SymX(writeTVarzh_fast) \
659 SymX(xorIntegerzh_fast) \
661 SymX(stg_interp_constr_entry) \
662 SymX(stg_interp_constr1_entry) \
663 SymX(stg_interp_constr2_entry) \
664 SymX(stg_interp_constr3_entry) \
665 SymX(stg_interp_constr4_entry) \
666 SymX(stg_interp_constr5_entry) \
667 SymX(stg_interp_constr6_entry) \
668 SymX(stg_interp_constr7_entry) \
669 SymX(stg_interp_constr8_entry) \
670 SymX(stgMallocBytesRWX) \
671 SymX(getAllocations) \
674 RTS_USER_SIGNALS_SYMBOLS
676 #ifdef SUPPORT_LONG_LONGS
677 #define RTS_LONG_LONG_SYMS \
678 SymX(int64ToIntegerzh_fast) \
679 SymX(word64ToIntegerzh_fast)
681 #define RTS_LONG_LONG_SYMS /* nothing */
684 // 64-bit support functions in libgcc.a
685 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
686 #define RTS_LIBGCC_SYMBOLS \
696 #elif defined(ia64_HOST_ARCH)
697 #define RTS_LIBGCC_SYMBOLS \
705 #define RTS_LIBGCC_SYMBOLS
708 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
709 // Symbols that don't have a leading underscore
710 // on Mac OS X. They have to receive special treatment,
711 // see machoInitSymbolsWithoutUnderscore()
712 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
717 /* entirely bogus claims about types of these symbols */
718 #define Sym(vvv) extern void vvv(void);
719 #define SymX(vvv) /**/
720 #define SymX_redirect(vvv,xxx) /**/
724 RTS_POSIX_ONLY_SYMBOLS
725 RTS_MINGW_ONLY_SYMBOLS
726 RTS_CYGWIN_ONLY_SYMBOLS
727 RTS_DARWIN_ONLY_SYMBOLS
733 #ifdef LEADING_UNDERSCORE
734 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
736 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
739 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
741 #define SymX(vvv) Sym(vvv)
743 // SymX_redirect allows us to redirect references to one symbol to
744 // another symbol. See newCAF/newDynCAF for an example.
745 #define SymX_redirect(vvv,xxx) \
746 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
749 static RtsSymbolVal rtsSyms[] = {
753 RTS_POSIX_ONLY_SYMBOLS
754 RTS_MINGW_ONLY_SYMBOLS
755 RTS_CYGWIN_ONLY_SYMBOLS
757 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
758 // dyld stub code contains references to this,
759 // but it should never be called because we treat
760 // lazy pointers as nonlazy.
761 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
763 { 0, 0 } /* sentinel */
766 /* -----------------------------------------------------------------------------
767 * Insert symbols into hash tables, checking for duplicates.
769 static void ghciInsertStrHashTable ( char* obj_name,
775 if (lookupHashTable(table, (StgWord)key) == NULL)
777 insertStrHashTable(table, (StgWord)key, data);
782 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
784 "whilst processing object file\n"
786 "This could be caused by:\n"
787 " * Loading two different object files which export the same symbol\n"
788 " * Specifying the same object file twice on the GHCi command line\n"
789 " * An incorrect `package.conf' entry, causing some object to be\n"
791 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
800 /* -----------------------------------------------------------------------------
801 * initialize the object linker
805 static int linker_init_done = 0 ;
807 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
808 static void *dl_prog_handle;
811 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
812 #if defined(openbsd_HOST_OS)
813 static void *dl_libc_handle;
821 /* Make initLinker idempotent, so we can call it
822 before evey relevant operation; that means we
823 don't need to initialise the linker separately */
824 if (linker_init_done == 1) { return; } else {
825 linker_init_done = 1;
828 symhash = allocStrHashTable();
830 /* populate the symbol table with stuff from the RTS */
831 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
832 ghciInsertStrHashTable("(GHCi built-in symbols)",
833 symhash, sym->lbl, sym->addr);
835 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
836 machoInitSymbolsWithoutUnderscore();
839 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
840 # if defined(RTLD_DEFAULT)
841 dl_prog_handle = RTLD_DEFAULT;
843 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
844 # if defined(openbsd_HOST_OS)
845 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
847 # endif /* RTLD_DEFAULT */
851 /* -----------------------------------------------------------------------------
852 * Loading DLL or .so dynamic libraries
853 * -----------------------------------------------------------------------------
855 * Add a DLL from which symbols may be found. In the ELF case, just
856 * do RTLD_GLOBAL-style add, so no further messing around needs to
857 * happen in order that symbols in the loaded .so are findable --
858 * lookupSymbol() will subsequently see them by dlsym on the program's
859 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
861 * In the PEi386 case, open the DLLs and put handles to them in a
862 * linked list. When looking for a symbol, try all handles in the
863 * list. This means that we need to load even DLLs that are guaranteed
864 * to be in the ghc.exe image already, just so we can get a handle
865 * to give to loadSymbol, so that we can find the symbols. For such
866 * libraries, the LoadLibrary call should be a no-op except for returning
871 #if defined(OBJFORMAT_PEi386)
872 /* A record for storing handles into DLLs. */
877 struct _OpenedDLL* next;
882 /* A list thereof. */
883 static OpenedDLL* opened_dlls = NULL;
887 addDLL( char *dll_name )
889 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
890 /* ------------------- ELF DLL loader ------------------- */
896 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
899 /* dlopen failed; return a ptr to the error msg. */
901 if (errmsg == NULL) errmsg = "addDLL: unknown error";
908 # elif defined(OBJFORMAT_PEi386)
909 /* ------------------- Win32 DLL loader ------------------- */
917 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
919 /* See if we've already got it, and ignore if so. */
920 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
921 if (0 == strcmp(o_dll->name, dll_name))
925 /* The file name has no suffix (yet) so that we can try
926 both foo.dll and foo.drv
928 The documentation for LoadLibrary says:
929 If no file name extension is specified in the lpFileName
930 parameter, the default library extension .dll is
931 appended. However, the file name string can include a trailing
932 point character (.) to indicate that the module name has no
935 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
936 sprintf(buf, "%s.DLL", dll_name);
937 instance = LoadLibrary(buf);
938 if (instance == NULL) {
939 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
940 instance = LoadLibrary(buf);
941 if (instance == NULL) {
944 /* LoadLibrary failed; return a ptr to the error msg. */
945 return "addDLL: unknown error";
950 /* Add this DLL to the list of DLLs in which to search for symbols. */
951 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
952 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
953 strcpy(o_dll->name, dll_name);
954 o_dll->instance = instance;
955 o_dll->next = opened_dlls;
960 barf("addDLL: not implemented on this platform");
964 /* -----------------------------------------------------------------------------
965 * lookup a symbol in the hash table
968 lookupSymbol( char *lbl )
972 ASSERT(symhash != NULL);
973 val = lookupStrHashTable(symhash, lbl);
976 # if defined(OBJFORMAT_ELF)
977 # if defined(openbsd_HOST_OS)
978 val = dlsym(dl_prog_handle, lbl);
979 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
980 # elif defined(x86_64_HOST_ARCH)
981 val = dlsym(dl_prog_handle, lbl);
982 if (val >= (void *)0x80000000) {
984 new_val = x86_64_high_symbol(lbl, val);
985 IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
990 # else /* not openbsd */
991 return dlsym(dl_prog_handle, lbl);
993 # elif defined(OBJFORMAT_MACHO)
994 if(NSIsSymbolNameDefined(lbl)) {
995 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
996 return NSAddressOfSymbol(symbol);
1000 # elif defined(OBJFORMAT_PEi386)
1003 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1004 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
1005 if (lbl[0] == '_') {
1006 /* HACK: if the name has an initial underscore, try stripping
1007 it off & look that up first. I've yet to verify whether there's
1008 a Rule that governs whether an initial '_' *should always* be
1009 stripped off when mapping from import lib name to the DLL name.
1011 sym = GetProcAddress(o_dll->instance, (lbl+1));
1013 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
1017 sym = GetProcAddress(o_dll->instance, lbl);
1019 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
1034 __attribute((unused))
1036 lookupLocalSymbol( ObjectCode* oc, char *lbl )
1040 val = lookupStrHashTable(oc->lochash, lbl);
1050 /* -----------------------------------------------------------------------------
1051 * Debugging aid: look in GHCi's object symbol tables for symbols
1052 * within DELTA bytes of the specified address, and show their names.
1055 void ghci_enquire ( char* addr );
1057 void ghci_enquire ( char* addr )
1062 const int DELTA = 64;
1067 for (oc = objects; oc; oc = oc->next) {
1068 for (i = 0; i < oc->n_symbols; i++) {
1069 sym = oc->symbols[i];
1070 if (sym == NULL) continue;
1071 // debugBelch("enquire %p %p\n", sym, oc->lochash);
1073 if (oc->lochash != NULL) {
1074 a = lookupStrHashTable(oc->lochash, sym);
1077 a = lookupStrHashTable(symhash, sym);
1080 // debugBelch("ghci_enquire: can't find %s\n", sym);
1082 else if (addr-DELTA <= a && a <= addr+DELTA) {
1083 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1090 #ifdef ia64_HOST_ARCH
1091 static unsigned int PLTSize(void);
1094 /* -----------------------------------------------------------------------------
1095 * Load an obj (populate the global symbol table, but don't resolve yet)
1097 * Returns: 1 if ok, 0 on error.
1100 loadObj( char *path )
1107 void *map_addr = NULL;
1114 /* debugBelch("loadObj %s\n", path ); */
1116 /* Check that we haven't already loaded this object.
1117 Ignore requests to load multiple times */
1121 for (o = objects; o; o = o->next) {
1122 if (0 == strcmp(o->fileName, path)) {
1124 break; /* don't need to search further */
1128 IF_DEBUG(linker, debugBelch(
1129 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1130 "same object file twice:\n"
1132 "GHCi will ignore this, but be warned.\n"
1134 return 1; /* success */
1138 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1140 # if defined(OBJFORMAT_ELF)
1141 oc->formatName = "ELF";
1142 # elif defined(OBJFORMAT_PEi386)
1143 oc->formatName = "PEi386";
1144 # elif defined(OBJFORMAT_MACHO)
1145 oc->formatName = "Mach-O";
1148 barf("loadObj: not implemented on this platform");
1151 r = stat(path, &st);
1152 if (r == -1) { return 0; }
1154 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1155 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1156 strcpy(oc->fileName, path);
1158 oc->fileSize = st.st_size;
1160 oc->sections = NULL;
1161 oc->lochash = allocStrHashTable();
1162 oc->proddables = NULL;
1164 /* chain it onto the list of objects */
1169 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1171 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1173 #if defined(openbsd_HOST_OS)
1174 fd = open(path, O_RDONLY, S_IRUSR);
1176 fd = open(path, O_RDONLY);
1179 barf("loadObj: can't open `%s'", path);
1181 pagesize = getpagesize();
1183 #ifdef ia64_HOST_ARCH
1184 /* The PLT needs to be right before the object */
1185 n = ROUND_UP(PLTSize(), pagesize);
1186 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1187 if (oc->plt == MAP_FAILED)
1188 barf("loadObj: can't allocate PLT");
1191 map_addr = oc->plt + n;
1194 n = ROUND_UP(oc->fileSize, pagesize);
1196 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
1197 * small memory model on this architecture (see gcc docs,
1200 #ifdef x86_64_HOST_ARCH
1201 #define EXTRA_MAP_FLAGS MAP_32BIT
1203 #define EXTRA_MAP_FLAGS 0
1206 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1207 MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1208 if (oc->image == MAP_FAILED)
1209 barf("loadObj: can't map `%s'", path);
1213 #else /* !USE_MMAP */
1215 /* load the image into memory */
1216 f = fopen(path, "rb");
1218 barf("loadObj: can't read `%s'", path);
1220 #ifdef darwin_HOST_OS
1221 // In a Mach-O .o file, all sections can and will be misaligned
1222 // if the total size of the headers is not a multiple of the
1223 // desired alignment. This is fine for .o files that only serve
1224 // as input for the static linker, but it's not fine for us,
1225 // as SSE (used by gcc for floating point) and Altivec require
1226 // 16-byte alignment.
1227 // We calculate the correct alignment from the header before
1228 // reading the file, and then we misalign oc->image on purpose so
1229 // that the actual sections end up aligned again.
1230 misalignment = machoGetMisalignment(f);
1231 oc->misalignment = misalignment;
1236 oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)");
1237 oc->image += misalignment;
1239 n = fread ( oc->image, 1, oc->fileSize, f );
1240 if (n != oc->fileSize)
1241 barf("loadObj: error whilst reading `%s'", path);
1245 #endif /* USE_MMAP */
1247 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1248 r = ocAllocateJumpIslands_MachO ( oc );
1249 if (!r) { return r; }
1250 # elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
1251 r = ocAllocateJumpIslands_ELF ( oc );
1252 if (!r) { return r; }
1255 /* verify the in-memory image */
1256 # if defined(OBJFORMAT_ELF)
1257 r = ocVerifyImage_ELF ( oc );
1258 # elif defined(OBJFORMAT_PEi386)
1259 r = ocVerifyImage_PEi386 ( oc );
1260 # elif defined(OBJFORMAT_MACHO)
1261 r = ocVerifyImage_MachO ( oc );
1263 barf("loadObj: no verify method");
1265 if (!r) { return r; }
1267 /* build the symbol list for this image */
1268 # if defined(OBJFORMAT_ELF)
1269 r = ocGetNames_ELF ( oc );
1270 # elif defined(OBJFORMAT_PEi386)
1271 r = ocGetNames_PEi386 ( oc );
1272 # elif defined(OBJFORMAT_MACHO)
1273 r = ocGetNames_MachO ( oc );
1275 barf("loadObj: no getNames method");
1277 if (!r) { return r; }
1279 /* loaded, but not resolved yet */
1280 oc->status = OBJECT_LOADED;
1285 /* -----------------------------------------------------------------------------
1286 * resolve all the currently unlinked objects in memory
1288 * Returns: 1 if ok, 0 on error.
1298 for (oc = objects; oc; oc = oc->next) {
1299 if (oc->status != OBJECT_RESOLVED) {
1300 # if defined(OBJFORMAT_ELF)
1301 r = ocResolve_ELF ( oc );
1302 # elif defined(OBJFORMAT_PEi386)
1303 r = ocResolve_PEi386 ( oc );
1304 # elif defined(OBJFORMAT_MACHO)
1305 r = ocResolve_MachO ( oc );
1307 barf("resolveObjs: not implemented on this platform");
1309 if (!r) { return r; }
1310 oc->status = OBJECT_RESOLVED;
1316 /* -----------------------------------------------------------------------------
1317 * delete an object from the pool
1320 unloadObj( char *path )
1322 ObjectCode *oc, *prev;
1324 ASSERT(symhash != NULL);
1325 ASSERT(objects != NULL);
1330 for (oc = objects; oc; prev = oc, oc = oc->next) {
1331 if (!strcmp(oc->fileName,path)) {
1333 /* Remove all the mappings for the symbols within this
1338 for (i = 0; i < oc->n_symbols; i++) {
1339 if (oc->symbols[i] != NULL) {
1340 removeStrHashTable(symhash, oc->symbols[i], NULL);
1348 prev->next = oc->next;
1351 /* We're going to leave this in place, in case there are
1352 any pointers from the heap into it: */
1353 /* stgFree(oc->image); */
1354 stgFree(oc->fileName);
1355 stgFree(oc->symbols);
1356 stgFree(oc->sections);
1357 /* The local hash table should have been freed at the end
1358 of the ocResolve_ call on it. */
1359 ASSERT(oc->lochash == NULL);
1365 errorBelch("unloadObj: can't find `%s' to unload", path);
1369 /* -----------------------------------------------------------------------------
1370 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1371 * which may be prodded during relocation, and abort if we try and write
1372 * outside any of these.
1374 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1377 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1378 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1382 pb->next = oc->proddables;
1383 oc->proddables = pb;
1386 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1389 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1390 char* s = (char*)(pb->start);
1391 char* e = s + pb->size - 1;
1392 char* a = (char*)addr;
1393 /* Assumes that the biggest fixup involves a 4-byte write. This
1394 probably needs to be changed to 8 (ie, +7) on 64-bit
1396 if (a >= s && (a+3) <= e) return;
1398 barf("checkProddableBlock: invalid fixup in runtime linker");
1401 /* -----------------------------------------------------------------------------
1402 * Section management.
1404 static void addSection ( ObjectCode* oc, SectionKind kind,
1405 void* start, void* end )
1407 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1411 s->next = oc->sections;
1414 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1415 start, ((char*)end)-1, end - start + 1, kind );
1420 /* --------------------------------------------------------------------------
1421 * PowerPC specifics (jump islands)
1422 * ------------------------------------------------------------------------*/
1424 #if defined(powerpc_HOST_ARCH)
1427 ocAllocateJumpIslands
1429 Allocate additional space at the end of the object file image to make room
1432 PowerPC relative branch instructions have a 24 bit displacement field.
1433 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1434 If a particular imported symbol is outside this range, we have to redirect
1435 the jump to a short piece of new code that just loads the 32bit absolute
1436 address and jumps there.
1437 This function just allocates space for one 16 byte ppcJumpIsland for every
1438 undefined symbol in the object file. The code for the islands is filled in by
1439 makeJumpIsland below.
1442 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1448 int misalignment = 0;
1450 misalignment = oc->misalignment;
1455 // round up to the nearest 4
1456 aligned = (oc->fileSize + 3) & ~3;
1459 #ifndef linux_HOST_OS /* mremap is a linux extension */
1460 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1463 pagesize = getpagesize();
1464 n = ROUND_UP( oc->fileSize, pagesize );
1465 m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
1467 /* If we have a half-page-size file and map one page of it then
1468 * the part of the page after the size of the file remains accessible.
1469 * If, however, we map in 2 pages, the 2nd page is not accessible
1470 * and will give a "Bus Error" on access. To get around this, we check
1471 * if we need any extra pages for the jump islands and map them in
1472 * anonymously. We must check that we actually require extra pages
1473 * otherwise the attempt to mmap 0 pages of anonymous memory will
1479 /* The effect of this mremap() call is only the ensure that we have
1480 * a sufficient number of virtually contiguous pages. As returned from
1481 * mremap, the pages past the end of the file are not backed. We give
1482 * them a backing by using MAP_FIXED to map in anonymous pages.
1484 oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE );
1486 if( oc->image == MAP_FAILED )
1488 errorBelch( "Unable to mremap for Jump Islands\n" );
1492 if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
1493 MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
1495 errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
1501 oc->image -= misalignment;
1502 oc->image = stgReallocBytes( oc->image,
1504 aligned + sizeof (ppcJumpIsland) * count,
1505 "ocAllocateJumpIslands" );
1506 oc->image += misalignment;
1507 #endif /* USE_MMAP */
1509 oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
1510 memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
1513 oc->jump_islands = NULL;
1515 oc->island_start_symbol = first;
1516 oc->n_islands = count;
1521 static unsigned long makeJumpIsland( ObjectCode* oc,
1522 unsigned long symbolNumber,
1523 unsigned long target )
1525 ppcJumpIsland *island;
1527 if( symbolNumber < oc->island_start_symbol ||
1528 symbolNumber - oc->island_start_symbol > oc->n_islands)
1531 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1533 // lis r12, hi16(target)
1534 island->lis_r12 = 0x3d80;
1535 island->hi_addr = target >> 16;
1537 // ori r12, r12, lo16(target)
1538 island->ori_r12_r12 = 0x618c;
1539 island->lo_addr = target & 0xffff;
1542 island->mtctr_r12 = 0x7d8903a6;
1545 island->bctr = 0x4e800420;
1547 return (unsigned long) island;
1551 ocFlushInstructionCache
1553 Flush the data & instruction caches.
1554 Because the PPC has split data/instruction caches, we have to
1555 do that whenever we modify code at runtime.
1558 static void ocFlushInstructionCache( ObjectCode *oc )
1560 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1561 unsigned long *p = (unsigned long *) oc->image;
1565 __asm__ volatile ( "dcbf 0,%0\n\t"
1573 __asm__ volatile ( "sync\n\t"
1579 /* --------------------------------------------------------------------------
1580 * PEi386 specifics (Win32 targets)
1581 * ------------------------------------------------------------------------*/
1583 /* The information for this linker comes from
1584 Microsoft Portable Executable
1585 and Common Object File Format Specification
1586 revision 5.1 January 1998
1587 which SimonM says comes from the MS Developer Network CDs.
1589 It can be found there (on older CDs), but can also be found
1592 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1594 (this is Rev 6.0 from February 1999).
1596 Things move, so if that fails, try searching for it via
1598 http://www.google.com/search?q=PE+COFF+specification
1600 The ultimate reference for the PE format is the Winnt.h
1601 header file that comes with the Platform SDKs; as always,
1602 implementations will drift wrt their documentation.
1604 A good background article on the PE format is Matt Pietrek's
1605 March 1994 article in Microsoft System Journal (MSJ)
1606 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1607 Win32 Portable Executable File Format." The info in there
1608 has recently been updated in a two part article in
1609 MSDN magazine, issues Feb and March 2002,
1610 "Inside Windows: An In-Depth Look into the Win32 Portable
1611 Executable File Format"
1613 John Levine's book "Linkers and Loaders" contains useful
1618 #if defined(OBJFORMAT_PEi386)
1622 typedef unsigned char UChar;
1623 typedef unsigned short UInt16;
1624 typedef unsigned int UInt32;
1631 UInt16 NumberOfSections;
1632 UInt32 TimeDateStamp;
1633 UInt32 PointerToSymbolTable;
1634 UInt32 NumberOfSymbols;
1635 UInt16 SizeOfOptionalHeader;
1636 UInt16 Characteristics;
1640 #define sizeof_COFF_header 20
1647 UInt32 VirtualAddress;
1648 UInt32 SizeOfRawData;
1649 UInt32 PointerToRawData;
1650 UInt32 PointerToRelocations;
1651 UInt32 PointerToLinenumbers;
1652 UInt16 NumberOfRelocations;
1653 UInt16 NumberOfLineNumbers;
1654 UInt32 Characteristics;
1658 #define sizeof_COFF_section 40
1665 UInt16 SectionNumber;
1668 UChar NumberOfAuxSymbols;
1672 #define sizeof_COFF_symbol 18
1677 UInt32 VirtualAddress;
1678 UInt32 SymbolTableIndex;
1683 #define sizeof_COFF_reloc 10
1686 /* From PE spec doc, section 3.3.2 */
1687 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1688 windows.h -- for the same purpose, but I want to know what I'm
1690 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1691 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1692 #define MYIMAGE_FILE_DLL 0x2000
1693 #define MYIMAGE_FILE_SYSTEM 0x1000
1694 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1695 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1696 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1698 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1699 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1700 #define MYIMAGE_SYM_CLASS_STATIC 3
1701 #define MYIMAGE_SYM_UNDEFINED 0
1703 /* From PE spec doc, section 4.1 */
1704 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1705 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1706 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1708 /* From PE spec doc, section 5.2.1 */
1709 #define MYIMAGE_REL_I386_DIR32 0x0006
1710 #define MYIMAGE_REL_I386_REL32 0x0014
1713 /* We use myindex to calculate array addresses, rather than
1714 simply doing the normal subscript thing. That's because
1715 some of the above structs have sizes which are not
1716 a whole number of words. GCC rounds their sizes up to a
1717 whole number of words, which means that the address calcs
1718 arising from using normal C indexing or pointer arithmetic
1719 are just plain wrong. Sigh.
1722 myindex ( int scale, void* base, int index )
1725 ((UChar*)base) + scale * index;
1730 printName ( UChar* name, UChar* strtab )
1732 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1733 UInt32 strtab_offset = * (UInt32*)(name+4);
1734 debugBelch("%s", strtab + strtab_offset );
1737 for (i = 0; i < 8; i++) {
1738 if (name[i] == 0) break;
1739 debugBelch("%c", name[i] );
1746 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1748 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1749 UInt32 strtab_offset = * (UInt32*)(name+4);
1750 strncpy ( dst, strtab+strtab_offset, dstSize );
1756 if (name[i] == 0) break;
1766 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1769 /* If the string is longer than 8 bytes, look in the
1770 string table for it -- this will be correctly zero terminated.
1772 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1773 UInt32 strtab_offset = * (UInt32*)(name+4);
1774 return ((UChar*)strtab) + strtab_offset;
1776 /* Otherwise, if shorter than 8 bytes, return the original,
1777 which by defn is correctly terminated.
1779 if (name[7]==0) return name;
1780 /* The annoying case: 8 bytes. Copy into a temporary
1781 (which is never freed ...)
1783 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1785 strncpy(newstr,name,8);
1791 /* Just compares the short names (first 8 chars) */
1792 static COFF_section *
1793 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1797 = (COFF_header*)(oc->image);
1798 COFF_section* sectab
1800 ((UChar*)(oc->image))
1801 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1803 for (i = 0; i < hdr->NumberOfSections; i++) {
1806 COFF_section* section_i
1808 myindex ( sizeof_COFF_section, sectab, i );
1809 n1 = (UChar*) &(section_i->Name);
1811 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1812 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1813 n1[6]==n2[6] && n1[7]==n2[7])
1822 zapTrailingAtSign ( UChar* sym )
1824 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1826 if (sym[0] == 0) return;
1828 while (sym[i] != 0) i++;
1831 while (j > 0 && my_isdigit(sym[j])) j--;
1832 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1838 ocVerifyImage_PEi386 ( ObjectCode* oc )
1843 COFF_section* sectab;
1844 COFF_symbol* symtab;
1846 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1847 hdr = (COFF_header*)(oc->image);
1848 sectab = (COFF_section*) (
1849 ((UChar*)(oc->image))
1850 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1852 symtab = (COFF_symbol*) (
1853 ((UChar*)(oc->image))
1854 + hdr->PointerToSymbolTable
1856 strtab = ((UChar*)symtab)
1857 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1859 if (hdr->Machine != 0x14c) {
1860 errorBelch("%s: Not x86 PEi386", oc->fileName);
1863 if (hdr->SizeOfOptionalHeader != 0) {
1864 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
1867 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1868 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1869 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1870 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1871 errorBelch("%s: Not a PEi386 object file", oc->fileName);
1874 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1875 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1876 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
1878 (int)(hdr->Characteristics));
1881 /* If the string table size is way crazy, this might indicate that
1882 there are more than 64k relocations, despite claims to the
1883 contrary. Hence this test. */
1884 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1886 if ( (*(UInt32*)strtab) > 600000 ) {
1887 /* Note that 600k has no special significance other than being
1888 big enough to handle the almost-2MB-sized lumps that
1889 constitute HSwin32*.o. */
1890 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1895 /* No further verification after this point; only debug printing. */
1897 IF_DEBUG(linker, i=1);
1898 if (i == 0) return 1;
1900 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1901 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1902 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1905 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1906 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1907 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1908 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1909 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1910 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1911 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1913 /* Print the section table. */
1915 for (i = 0; i < hdr->NumberOfSections; i++) {
1917 COFF_section* sectab_i
1919 myindex ( sizeof_COFF_section, sectab, i );
1926 printName ( sectab_i->Name, strtab );
1936 sectab_i->VirtualSize,
1937 sectab_i->VirtualAddress,
1938 sectab_i->SizeOfRawData,
1939 sectab_i->PointerToRawData,
1940 sectab_i->NumberOfRelocations,
1941 sectab_i->PointerToRelocations,
1942 sectab_i->PointerToRawData
1944 reltab = (COFF_reloc*) (
1945 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1948 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1949 /* If the relocation field (a short) has overflowed, the
1950 * real count can be found in the first reloc entry.
1952 * See Section 4.1 (last para) of the PE spec (rev6.0).
1954 COFF_reloc* rel = (COFF_reloc*)
1955 myindex ( sizeof_COFF_reloc, reltab, 0 );
1956 noRelocs = rel->VirtualAddress;
1959 noRelocs = sectab_i->NumberOfRelocations;
1963 for (; j < noRelocs; j++) {
1965 COFF_reloc* rel = (COFF_reloc*)
1966 myindex ( sizeof_COFF_reloc, reltab, j );
1968 " type 0x%-4x vaddr 0x%-8x name `",
1970 rel->VirtualAddress );
1971 sym = (COFF_symbol*)
1972 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1973 /* Hmm..mysterious looking offset - what's it for? SOF */
1974 printName ( sym->Name, strtab -10 );
1981 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
1982 debugBelch("---START of string table---\n");
1983 for (i = 4; i < *(Int32*)strtab; i++) {
1985 debugBelch("\n"); else
1986 debugBelch("%c", strtab[i] );
1988 debugBelch("--- END of string table---\n");
1993 COFF_symbol* symtab_i;
1994 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1995 symtab_i = (COFF_symbol*)
1996 myindex ( sizeof_COFF_symbol, symtab, i );
2002 printName ( symtab_i->Name, strtab );
2011 (Int32)(symtab_i->SectionNumber),
2012 (UInt32)symtab_i->Type,
2013 (UInt32)symtab_i->StorageClass,
2014 (UInt32)symtab_i->NumberOfAuxSymbols
2016 i += symtab_i->NumberOfAuxSymbols;
2026 ocGetNames_PEi386 ( ObjectCode* oc )
2029 COFF_section* sectab;
2030 COFF_symbol* symtab;
2037 hdr = (COFF_header*)(oc->image);
2038 sectab = (COFF_section*) (
2039 ((UChar*)(oc->image))
2040 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2042 symtab = (COFF_symbol*) (
2043 ((UChar*)(oc->image))
2044 + hdr->PointerToSymbolTable
2046 strtab = ((UChar*)(oc->image))
2047 + hdr->PointerToSymbolTable
2048 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2050 /* Allocate space for any (local, anonymous) .bss sections. */
2052 for (i = 0; i < hdr->NumberOfSections; i++) {
2055 COFF_section* sectab_i
2057 myindex ( sizeof_COFF_section, sectab, i );
2058 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2059 /* sof 10/05: the PE spec text isn't too clear regarding what
2060 * the SizeOfRawData field is supposed to hold for object
2061 * file sections containing just uninitialized data -- for executables,
2062 * it is supposed to be zero; unclear what it's supposed to be
2063 * for object files. However, VirtualSize is guaranteed to be
2064 * zero for object files, which definitely suggests that SizeOfRawData
2065 * will be non-zero (where else would the size of this .bss section be
2066 * stored?) Looking at the COFF_section info for incoming object files,
2067 * this certainly appears to be the case.
2069 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
2070 * object files up until now. This turned out to bite us with ghc-6.4.1's use
2071 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
2072 * variable decls into to the .bss section. (The specific function in Q which
2073 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
2075 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
2076 /* This is a non-empty .bss section. Allocate zeroed space for
2077 it, and set its PointerToRawData field such that oc->image +
2078 PointerToRawData == addr_of_zeroed_space. */
2079 bss_sz = sectab_i->VirtualSize;
2080 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
2081 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
2082 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2083 addProddableBlock(oc, zspace, bss_sz);
2084 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2087 /* Copy section information into the ObjectCode. */
2089 for (i = 0; i < hdr->NumberOfSections; i++) {
2095 = SECTIONKIND_OTHER;
2096 COFF_section* sectab_i
2098 myindex ( sizeof_COFF_section, sectab, i );
2099 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2102 /* I'm sure this is the Right Way to do it. However, the
2103 alternative of testing the sectab_i->Name field seems to
2104 work ok with Cygwin.
2106 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2107 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2108 kind = SECTIONKIND_CODE_OR_RODATA;
2111 if (0==strcmp(".text",sectab_i->Name) ||
2112 0==strcmp(".rdata",sectab_i->Name)||
2113 0==strcmp(".rodata",sectab_i->Name))
2114 kind = SECTIONKIND_CODE_OR_RODATA;
2115 if (0==strcmp(".data",sectab_i->Name) ||
2116 0==strcmp(".bss",sectab_i->Name))
2117 kind = SECTIONKIND_RWDATA;
2119 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2120 sz = sectab_i->SizeOfRawData;
2121 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2123 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2124 end = start + sz - 1;
2126 if (kind == SECTIONKIND_OTHER
2127 /* Ignore sections called which contain stabs debugging
2129 && 0 != strcmp(".stab", sectab_i->Name)
2130 && 0 != strcmp(".stabstr", sectab_i->Name)
2131 /* ignore constructor section for now */
2132 && 0 != strcmp(".ctors", sectab_i->Name)
2134 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2138 if (kind != SECTIONKIND_OTHER && end >= start) {
2139 addSection(oc, kind, start, end);
2140 addProddableBlock(oc, start, end - start + 1);
2144 /* Copy exported symbols into the ObjectCode. */
2146 oc->n_symbols = hdr->NumberOfSymbols;
2147 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2148 "ocGetNames_PEi386(oc->symbols)");
2149 /* Call me paranoid; I don't care. */
2150 for (i = 0; i < oc->n_symbols; i++)
2151 oc->symbols[i] = NULL;
2155 COFF_symbol* symtab_i;
2156 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2157 symtab_i = (COFF_symbol*)
2158 myindex ( sizeof_COFF_symbol, symtab, i );
2162 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2163 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2164 /* This symbol is global and defined, viz, exported */
2165 /* for MYIMAGE_SYMCLASS_EXTERNAL
2166 && !MYIMAGE_SYM_UNDEFINED,
2167 the address of the symbol is:
2168 address of relevant section + offset in section
2170 COFF_section* sectabent
2171 = (COFF_section*) myindex ( sizeof_COFF_section,
2173 symtab_i->SectionNumber-1 );
2174 addr = ((UChar*)(oc->image))
2175 + (sectabent->PointerToRawData
2179 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2180 && symtab_i->Value > 0) {
2181 /* This symbol isn't in any section at all, ie, global bss.
2182 Allocate zeroed space for it. */
2183 addr = stgCallocBytes(1, symtab_i->Value,
2184 "ocGetNames_PEi386(non-anonymous bss)");
2185 addSection(oc, SECTIONKIND_RWDATA, addr,
2186 ((UChar*)addr) + symtab_i->Value - 1);
2187 addProddableBlock(oc, addr, symtab_i->Value);
2188 /* debugBelch("BSS section at 0x%x\n", addr); */
2191 if (addr != NULL ) {
2192 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2193 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2194 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2195 ASSERT(i >= 0 && i < oc->n_symbols);
2196 /* cstring_from_COFF_symbol_name always succeeds. */
2197 oc->symbols[i] = sname;
2198 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2202 "IGNORING symbol %d\n"
2206 printName ( symtab_i->Name, strtab );
2215 (Int32)(symtab_i->SectionNumber),
2216 (UInt32)symtab_i->Type,
2217 (UInt32)symtab_i->StorageClass,
2218 (UInt32)symtab_i->NumberOfAuxSymbols
2223 i += symtab_i->NumberOfAuxSymbols;
2232 ocResolve_PEi386 ( ObjectCode* oc )
2235 COFF_section* sectab;
2236 COFF_symbol* symtab;
2246 /* ToDo: should be variable-sized? But is at least safe in the
2247 sense of buffer-overrun-proof. */
2249 /* debugBelch("resolving for %s\n", oc->fileName); */
2251 hdr = (COFF_header*)(oc->image);
2252 sectab = (COFF_section*) (
2253 ((UChar*)(oc->image))
2254 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2256 symtab = (COFF_symbol*) (
2257 ((UChar*)(oc->image))
2258 + hdr->PointerToSymbolTable
2260 strtab = ((UChar*)(oc->image))
2261 + hdr->PointerToSymbolTable
2262 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2264 for (i = 0; i < hdr->NumberOfSections; i++) {
2265 COFF_section* sectab_i
2267 myindex ( sizeof_COFF_section, sectab, i );
2270 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2273 /* Ignore sections called which contain stabs debugging
2275 if (0 == strcmp(".stab", sectab_i->Name)
2276 || 0 == strcmp(".stabstr", sectab_i->Name)
2277 || 0 == strcmp(".ctors", sectab_i->Name))
2280 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2281 /* If the relocation field (a short) has overflowed, the
2282 * real count can be found in the first reloc entry.
2284 * See Section 4.1 (last para) of the PE spec (rev6.0).
2286 * Nov2003 update: the GNU linker still doesn't correctly
2287 * handle the generation of relocatable object files with
2288 * overflown relocations. Hence the output to warn of potential
2291 COFF_reloc* rel = (COFF_reloc*)
2292 myindex ( sizeof_COFF_reloc, reltab, 0 );
2293 noRelocs = rel->VirtualAddress;
2295 /* 10/05: we now assume (and check for) a GNU ld that is capable
2296 * of handling object files with (>2^16) of relocs.
2299 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2304 noRelocs = sectab_i->NumberOfRelocations;
2309 for (; j < noRelocs; j++) {
2311 COFF_reloc* reltab_j
2313 myindex ( sizeof_COFF_reloc, reltab, j );
2315 /* the location to patch */
2317 ((UChar*)(oc->image))
2318 + (sectab_i->PointerToRawData
2319 + reltab_j->VirtualAddress
2320 - sectab_i->VirtualAddress )
2322 /* the existing contents of pP */
2324 /* the symbol to connect to */
2325 sym = (COFF_symbol*)
2326 myindex ( sizeof_COFF_symbol,
2327 symtab, reltab_j->SymbolTableIndex );
2330 "reloc sec %2d num %3d: type 0x%-4x "
2331 "vaddr 0x%-8x name `",
2333 (UInt32)reltab_j->Type,
2334 reltab_j->VirtualAddress );
2335 printName ( sym->Name, strtab );
2336 debugBelch("'\n" ));
2338 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2339 COFF_section* section_sym
2340 = findPEi386SectionCalled ( oc, sym->Name );
2342 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2345 S = ((UInt32)(oc->image))
2346 + (section_sym->PointerToRawData
2349 copyName ( sym->Name, strtab, symbol, 1000-1 );
2350 (void*)S = lookupLocalSymbol( oc, symbol );
2351 if ((void*)S != NULL) goto foundit;
2352 (void*)S = lookupSymbol( symbol );
2353 if ((void*)S != NULL) goto foundit;
2354 zapTrailingAtSign ( symbol );
2355 (void*)S = lookupLocalSymbol( oc, symbol );
2356 if ((void*)S != NULL) goto foundit;
2357 (void*)S = lookupSymbol( symbol );
2358 if ((void*)S != NULL) goto foundit;
2359 /* Newline first because the interactive linker has printed "linking..." */
2360 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2364 checkProddableBlock(oc, pP);
2365 switch (reltab_j->Type) {
2366 case MYIMAGE_REL_I386_DIR32:
2369 case MYIMAGE_REL_I386_REL32:
2370 /* Tricky. We have to insert a displacement at
2371 pP which, when added to the PC for the _next_
2372 insn, gives the address of the target (S).
2373 Problem is to know the address of the next insn
2374 when we only know pP. We assume that this
2375 literal field is always the last in the insn,
2376 so that the address of the next insn is pP+4
2377 -- hence the constant 4.
2378 Also I don't know if A should be added, but so
2379 far it has always been zero.
2381 SOF 05/2005: 'A' (old contents of *pP) have been observed
2382 to contain values other than zero (the 'wx' object file
2383 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2384 So, add displacement to old value instead of asserting
2385 A to be zero. Fixes wxhaskell-related crashes, and no other
2386 ill effects have been observed.
2388 Update: the reason why we're seeing these more elaborate
2389 relocations is due to a switch in how the NCG compiles SRTs
2390 and offsets to them from info tables. SRTs live in .(ro)data,
2391 while info tables live in .text, causing GAS to emit REL32/DISP32
2392 relocations with non-zero values. Adding the displacement is
2393 the right thing to do.
2395 *pP = S - ((UInt32)pP) - 4 + A;
2398 debugBelch("%s: unhandled PEi386 relocation type %d",
2399 oc->fileName, reltab_j->Type);
2406 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2410 #endif /* defined(OBJFORMAT_PEi386) */
2413 /* --------------------------------------------------------------------------
2415 * ------------------------------------------------------------------------*/
2417 #if defined(OBJFORMAT_ELF)
2422 #if defined(sparc_HOST_ARCH)
2423 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2424 #elif defined(i386_HOST_ARCH)
2425 # define ELF_TARGET_386 /* Used inside <elf.h> */
2426 #elif defined(x86_64_HOST_ARCH)
2427 # define ELF_TARGET_X64_64
2429 #elif defined (ia64_HOST_ARCH)
2430 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2432 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2433 # define ELF_NEED_GOT /* needs Global Offset Table */
2434 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2437 #if !defined(openbsd_HOST_OS)
2440 /* openbsd elf has things in different places, with diff names */
2441 #include <elf_abi.h>
2442 #include <machine/reloc.h>
2443 #define R_386_32 RELOC_32
2444 #define R_386_PC32 RELOC_PC32
2448 * Define a set of types which can be used for both ELF32 and ELF64
2452 #define ELFCLASS ELFCLASS64
2453 #define Elf_Addr Elf64_Addr
2454 #define Elf_Word Elf64_Word
2455 #define Elf_Sword Elf64_Sword
2456 #define Elf_Ehdr Elf64_Ehdr
2457 #define Elf_Phdr Elf64_Phdr
2458 #define Elf_Shdr Elf64_Shdr
2459 #define Elf_Sym Elf64_Sym
2460 #define Elf_Rel Elf64_Rel
2461 #define Elf_Rela Elf64_Rela
2462 #define ELF_ST_TYPE ELF64_ST_TYPE
2463 #define ELF_ST_BIND ELF64_ST_BIND
2464 #define ELF_R_TYPE ELF64_R_TYPE
2465 #define ELF_R_SYM ELF64_R_SYM
2467 #define ELFCLASS ELFCLASS32
2468 #define Elf_Addr Elf32_Addr
2469 #define Elf_Word Elf32_Word
2470 #define Elf_Sword Elf32_Sword
2471 #define Elf_Ehdr Elf32_Ehdr
2472 #define Elf_Phdr Elf32_Phdr
2473 #define Elf_Shdr Elf32_Shdr
2474 #define Elf_Sym Elf32_Sym
2475 #define Elf_Rel Elf32_Rel
2476 #define Elf_Rela Elf32_Rela
2478 #define ELF_ST_TYPE ELF32_ST_TYPE
2481 #define ELF_ST_BIND ELF32_ST_BIND
2484 #define ELF_R_TYPE ELF32_R_TYPE
2487 #define ELF_R_SYM ELF32_R_SYM
2493 * Functions to allocate entries in dynamic sections. Currently we simply
2494 * preallocate a large number, and we don't check if a entry for the given
2495 * target already exists (a linear search is too slow). Ideally these
2496 * entries would be associated with symbols.
2499 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2500 #define GOT_SIZE 0x20000
2501 #define FUNCTION_TABLE_SIZE 0x10000
2502 #define PLT_SIZE 0x08000
2505 static Elf_Addr got[GOT_SIZE];
2506 static unsigned int gotIndex;
2507 static Elf_Addr gp_val = (Elf_Addr)got;
2510 allocateGOTEntry(Elf_Addr target)
2514 if (gotIndex >= GOT_SIZE)
2515 barf("Global offset table overflow");
2517 entry = &got[gotIndex++];
2519 return (Elf_Addr)entry;
2523 #ifdef ELF_FUNCTION_DESC
2529 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2530 static unsigned int functionTableIndex;
2533 allocateFunctionDesc(Elf_Addr target)
2535 FunctionDesc *entry;
2537 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2538 barf("Function table overflow");
2540 entry = &functionTable[functionTableIndex++];
2542 entry->gp = (Elf_Addr)gp_val;
2543 return (Elf_Addr)entry;
2547 copyFunctionDesc(Elf_Addr target)
2549 FunctionDesc *olddesc = (FunctionDesc *)target;
2550 FunctionDesc *newdesc;
2552 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2553 newdesc->gp = olddesc->gp;
2554 return (Elf_Addr)newdesc;
2559 #ifdef ia64_HOST_ARCH
2560 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2561 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2563 static unsigned char plt_code[] =
2565 /* taken from binutils bfd/elfxx-ia64.c */
2566 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2567 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2568 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2569 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2570 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2571 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2574 /* If we can't get to the function descriptor via gp, take a local copy of it */
2575 #define PLT_RELOC(code, target) { \
2576 Elf64_Sxword rel_value = target - gp_val; \
2577 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2578 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2580 ia64_reloc_gprel22((Elf_Addr)code, target); \
2585 unsigned char code[sizeof(plt_code)];
2589 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2591 PLTEntry *plt = (PLTEntry *)oc->plt;
2594 if (oc->pltIndex >= PLT_SIZE)
2595 barf("Procedure table overflow");
2597 entry = &plt[oc->pltIndex++];
2598 memcpy(entry->code, plt_code, sizeof(entry->code));
2599 PLT_RELOC(entry->code, target);
2600 return (Elf_Addr)entry;
2606 return (PLT_SIZE * sizeof(PLTEntry));
2611 #if x86_64_HOST_ARCH
2612 // On x86_64, 32-bit relocations are often used, which requires that
2613 // we can resolve a symbol to a 32-bit offset. However, shared
2614 // libraries are placed outside the 2Gb area, which leaves us with a
2615 // problem when we need to give a 32-bit offset to a symbol in a
2618 // For a function symbol, we can allocate a bounce sequence inside the
2619 // 2Gb area and resolve the symbol to this. The bounce sequence is
2620 // simply a long jump instruction to the real location of the symbol.
2622 // For data references, we're screwed.
2625 unsigned char jmp[8]; /* 6 byte instruction: jmpq *0x00000002(%rip) */
2629 #define X86_64_BB_SIZE 1024
2631 static x86_64_bounce *x86_64_bounce_buffer = NULL;
2632 static nat x86_64_bb_next_off;
2635 x86_64_high_symbol( char *lbl, void *addr )
2637 x86_64_bounce *bounce;
2639 if ( x86_64_bounce_buffer == NULL ||
2640 x86_64_bb_next_off >= X86_64_BB_SIZE ) {
2641 x86_64_bounce_buffer =
2642 mmap(NULL, X86_64_BB_SIZE * sizeof(x86_64_bounce),
2643 PROT_EXEC|PROT_READ|PROT_WRITE,
2644 MAP_PRIVATE|MAP_32BIT|MAP_ANONYMOUS, -1, 0);
2645 if (x86_64_bounce_buffer == MAP_FAILED) {
2646 barf("x86_64_high_symbol: mmap failed");
2648 x86_64_bb_next_off = 0;
2650 bounce = &x86_64_bounce_buffer[x86_64_bb_next_off];
2651 bounce->jmp[0] = 0xff;
2652 bounce->jmp[1] = 0x25;
2653 bounce->jmp[2] = 0x02;
2654 bounce->jmp[3] = 0x00;
2655 bounce->jmp[4] = 0x00;
2656 bounce->jmp[5] = 0x00;
2657 bounce->addr = addr;
2658 x86_64_bb_next_off++;
2660 IF_DEBUG(linker, debugBelch("x86_64: allocated bounce entry for %s->%p at %p\n",
2661 lbl, addr, bounce));
2663 insertStrHashTable(symhash, lbl, bounce);
2670 * Generic ELF functions
2674 findElfSection ( void* objImage, Elf_Word sh_type )
2676 char* ehdrC = (char*)objImage;
2677 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2678 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2679 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2683 for (i = 0; i < ehdr->e_shnum; i++) {
2684 if (shdr[i].sh_type == sh_type
2685 /* Ignore the section header's string table. */
2686 && i != ehdr->e_shstrndx
2687 /* Ignore string tables named .stabstr, as they contain
2689 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2691 ptr = ehdrC + shdr[i].sh_offset;
2698 #if defined(ia64_HOST_ARCH)
2700 findElfSegment ( void* objImage, Elf_Addr vaddr )
2702 char* ehdrC = (char*)objImage;
2703 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2704 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2705 Elf_Addr segaddr = 0;
2708 for (i = 0; i < ehdr->e_phnum; i++) {
2709 segaddr = phdr[i].p_vaddr;
2710 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2718 ocVerifyImage_ELF ( ObjectCode* oc )
2722 int i, j, nent, nstrtab, nsymtabs;
2726 char* ehdrC = (char*)(oc->image);
2727 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2729 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2730 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2731 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2732 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2733 errorBelch("%s: not an ELF object", oc->fileName);
2737 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2738 errorBelch("%s: unsupported ELF format", oc->fileName);
2742 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2743 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2745 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2746 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2748 errorBelch("%s: unknown endiannness", oc->fileName);
2752 if (ehdr->e_type != ET_REL) {
2753 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2756 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2758 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2759 switch (ehdr->e_machine) {
2760 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2761 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2763 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2765 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2767 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2769 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2770 errorBelch("%s: unknown architecture", oc->fileName);
2774 IF_DEBUG(linker,debugBelch(
2775 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
2776 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2778 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2780 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2782 if (ehdr->e_shstrndx == SHN_UNDEF) {
2783 errorBelch("%s: no section header string table", oc->fileName);
2786 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2788 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2791 for (i = 0; i < ehdr->e_shnum; i++) {
2792 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2793 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2794 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2795 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2796 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2797 ehdrC + shdr[i].sh_offset,
2798 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2800 if (shdr[i].sh_type == SHT_REL) {
2801 IF_DEBUG(linker,debugBelch("Rel " ));
2802 } else if (shdr[i].sh_type == SHT_RELA) {
2803 IF_DEBUG(linker,debugBelch("RelA " ));
2805 IF_DEBUG(linker,debugBelch(" "));
2808 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2812 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2815 for (i = 0; i < ehdr->e_shnum; i++) {
2816 if (shdr[i].sh_type == SHT_STRTAB
2817 /* Ignore the section header's string table. */
2818 && i != ehdr->e_shstrndx
2819 /* Ignore string tables named .stabstr, as they contain
2821 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2823 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2824 strtab = ehdrC + shdr[i].sh_offset;
2829 errorBelch("%s: no string tables, or too many", oc->fileName);
2834 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2835 for (i = 0; i < ehdr->e_shnum; i++) {
2836 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2837 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2839 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2840 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2841 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
2843 (long)shdr[i].sh_size % sizeof(Elf_Sym)
2845 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2846 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2849 for (j = 0; j < nent; j++) {
2850 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2851 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2852 (int)stab[j].st_shndx,
2853 (int)stab[j].st_size,
2854 (char*)stab[j].st_value ));
2856 IF_DEBUG(linker,debugBelch("type=" ));
2857 switch (ELF_ST_TYPE(stab[j].st_info)) {
2858 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2859 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2860 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2861 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2862 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2863 default: IF_DEBUG(linker,debugBelch("? " )); break;
2865 IF_DEBUG(linker,debugBelch(" " ));
2867 IF_DEBUG(linker,debugBelch("bind=" ));
2868 switch (ELF_ST_BIND(stab[j].st_info)) {
2869 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2870 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2871 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2872 default: IF_DEBUG(linker,debugBelch("? " )); break;
2874 IF_DEBUG(linker,debugBelch(" " ));
2876 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2880 if (nsymtabs == 0) {
2881 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2888 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2892 if (hdr->sh_type == SHT_PROGBITS
2893 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2894 /* .text-style section */
2895 return SECTIONKIND_CODE_OR_RODATA;
2898 if (hdr->sh_type == SHT_PROGBITS
2899 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2900 /* .data-style section */
2901 return SECTIONKIND_RWDATA;
2904 if (hdr->sh_type == SHT_PROGBITS
2905 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2906 /* .rodata-style section */
2907 return SECTIONKIND_CODE_OR_RODATA;
2910 if (hdr->sh_type == SHT_NOBITS
2911 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2912 /* .bss-style section */
2914 return SECTIONKIND_RWDATA;
2917 return SECTIONKIND_OTHER;
2922 ocGetNames_ELF ( ObjectCode* oc )
2927 char* ehdrC = (char*)(oc->image);
2928 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2929 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2930 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2932 ASSERT(symhash != NULL);
2935 errorBelch("%s: no strtab", oc->fileName);
2940 for (i = 0; i < ehdr->e_shnum; i++) {
2941 /* Figure out what kind of section it is. Logic derived from
2942 Figure 1.14 ("Special Sections") of the ELF document
2943 ("Portable Formats Specification, Version 1.1"). */
2945 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2947 if (is_bss && shdr[i].sh_size > 0) {
2948 /* This is a non-empty .bss section. Allocate zeroed space for
2949 it, and set its .sh_offset field such that
2950 ehdrC + .sh_offset == addr_of_zeroed_space. */
2951 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2952 "ocGetNames_ELF(BSS)");
2953 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2955 debugBelch("BSS section at 0x%x, size %d\n",
2956 zspace, shdr[i].sh_size);
2960 /* fill in the section info */
2961 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2962 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2963 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2964 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2967 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2969 /* copy stuff into this module's object symbol table */
2970 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2971 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2973 oc->n_symbols = nent;
2974 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2975 "ocGetNames_ELF(oc->symbols)");
2977 for (j = 0; j < nent; j++) {
2979 char isLocal = FALSE; /* avoids uninit-var warning */
2981 char* nm = strtab + stab[j].st_name;
2982 int secno = stab[j].st_shndx;
2984 /* Figure out if we want to add it; if so, set ad to its
2985 address. Otherwise leave ad == NULL. */
2987 if (secno == SHN_COMMON) {
2989 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2991 debugBelch("COMMON symbol, size %d name %s\n",
2992 stab[j].st_size, nm);
2994 /* Pointless to do addProddableBlock() for this area,
2995 since the linker should never poke around in it. */
2998 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2999 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3001 /* and not an undefined symbol */
3002 && stab[j].st_shndx != SHN_UNDEF
3003 /* and not in a "special section" */
3004 && stab[j].st_shndx < SHN_LORESERVE
3006 /* and it's a not a section or string table or anything silly */
3007 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3008 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3009 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3012 /* Section 0 is the undefined section, hence > and not >=. */
3013 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3015 if (shdr[secno].sh_type == SHT_NOBITS) {
3016 debugBelch(" BSS symbol, size %d off %d name %s\n",
3017 stab[j].st_size, stab[j].st_value, nm);
3020 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3021 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3024 #ifdef ELF_FUNCTION_DESC
3025 /* dlsym() and the initialisation table both give us function
3026 * descriptors, so to be consistent we store function descriptors
3027 * in the symbol table */
3028 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3029 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3031 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
3032 ad, oc->fileName, nm ));
3037 /* And the decision is ... */
3041 oc->symbols[j] = nm;
3044 /* Ignore entirely. */
3046 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3050 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3051 strtab + stab[j].st_name ));
3054 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3055 (int)ELF_ST_BIND(stab[j].st_info),
3056 (int)ELF_ST_TYPE(stab[j].st_info),
3057 (int)stab[j].st_shndx,
3058 strtab + stab[j].st_name
3061 oc->symbols[j] = NULL;
3070 /* Do ELF relocations which lack an explicit addend. All x86-linux
3071 relocations appear to be of this form. */
3073 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3074 Elf_Shdr* shdr, int shnum,
3075 Elf_Sym* stab, char* strtab )
3080 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3081 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3082 int target_shndx = shdr[shnum].sh_info;
3083 int symtab_shndx = shdr[shnum].sh_link;
3085 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3086 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3087 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3088 target_shndx, symtab_shndx ));
3090 /* Skip sections that we're not interested in. */
3093 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3094 if (kind == SECTIONKIND_OTHER) {
3095 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3100 for (j = 0; j < nent; j++) {
3101 Elf_Addr offset = rtab[j].r_offset;
3102 Elf_Addr info = rtab[j].r_info;
3104 Elf_Addr P = ((Elf_Addr)targ) + offset;
3105 Elf_Word* pP = (Elf_Word*)P;
3111 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3112 j, (void*)offset, (void*)info ));
3114 IF_DEBUG(linker,debugBelch( " ZERO" ));
3117 Elf_Sym sym = stab[ELF_R_SYM(info)];
3118 /* First see if it is a local symbol. */
3119 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3120 /* Yes, so we can get the address directly from the ELF symbol
3122 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3124 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3125 + stab[ELF_R_SYM(info)].st_value);
3128 /* No, so look up the name in our global table. */
3129 symbol = strtab + sym.st_name;
3130 S_tmp = lookupSymbol( symbol );
3131 S = (Elf_Addr)S_tmp;
3134 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3137 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3140 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3141 (void*)P, (void*)S, (void*)A ));
3142 checkProddableBlock ( oc, pP );
3146 switch (ELF_R_TYPE(info)) {
3147 # ifdef i386_HOST_ARCH
3148 case R_386_32: *pP = value; break;
3149 case R_386_PC32: *pP = value - P; break;
3152 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3153 oc->fileName, (lnat)ELF_R_TYPE(info));
3161 /* Do ELF relocations for which explicit addends are supplied.
3162 sparc-solaris relocations appear to be of this form. */
3164 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3165 Elf_Shdr* shdr, int shnum,
3166 Elf_Sym* stab, char* strtab )
3169 char *symbol = NULL;
3171 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3172 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3173 int target_shndx = shdr[shnum].sh_info;
3174 int symtab_shndx = shdr[shnum].sh_link;
3176 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3177 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3178 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3179 target_shndx, symtab_shndx ));
3181 for (j = 0; j < nent; j++) {
3182 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3183 /* This #ifdef only serves to avoid unused-var warnings. */
3184 Elf_Addr offset = rtab[j].r_offset;
3185 Elf_Addr P = targ + offset;
3187 Elf_Addr info = rtab[j].r_info;
3188 Elf_Addr A = rtab[j].r_addend;
3192 # if defined(sparc_HOST_ARCH)
3193 Elf_Word* pP = (Elf_Word*)P;
3195 # elif defined(ia64_HOST_ARCH)
3196 Elf64_Xword *pP = (Elf64_Xword *)P;
3198 # elif defined(powerpc_HOST_ARCH)
3202 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3203 j, (void*)offset, (void*)info,
3206 IF_DEBUG(linker,debugBelch( " ZERO" ));
3209 Elf_Sym sym = stab[ELF_R_SYM(info)];
3210 /* First see if it is a local symbol. */
3211 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3212 /* Yes, so we can get the address directly from the ELF symbol
3214 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3216 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3217 + stab[ELF_R_SYM(info)].st_value);
3218 #ifdef ELF_FUNCTION_DESC
3219 /* Make a function descriptor for this function */
3220 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3221 S = allocateFunctionDesc(S + A);
3226 /* No, so look up the name in our global table. */
3227 symbol = strtab + sym.st_name;
3228 S_tmp = lookupSymbol( symbol );
3229 S = (Elf_Addr)S_tmp;
3231 #ifdef ELF_FUNCTION_DESC
3232 /* If a function, already a function descriptor - we would
3233 have to copy it to add an offset. */
3234 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3235 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3239 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3242 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3245 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3246 (void*)P, (void*)S, (void*)A ));
3247 /* checkProddableBlock ( oc, (void*)P ); */
3251 switch (ELF_R_TYPE(info)) {
3252 # if defined(sparc_HOST_ARCH)
3253 case R_SPARC_WDISP30:
3254 w1 = *pP & 0xC0000000;
3255 w2 = (Elf_Word)((value - P) >> 2);
3256 ASSERT((w2 & 0xC0000000) == 0);
3261 w1 = *pP & 0xFFC00000;
3262 w2 = (Elf_Word)(value >> 10);
3263 ASSERT((w2 & 0xFFC00000) == 0);
3269 w2 = (Elf_Word)(value & 0x3FF);
3270 ASSERT((w2 & ~0x3FF) == 0);
3274 /* According to the Sun documentation:
3276 This relocation type resembles R_SPARC_32, except it refers to an
3277 unaligned word. That is, the word to be relocated must be treated
3278 as four separate bytes with arbitrary alignment, not as a word
3279 aligned according to the architecture requirements.
3281 (JRS: which means that freeloading on the R_SPARC_32 case
3282 is probably wrong, but hey ...)
3286 w2 = (Elf_Word)value;
3289 # elif defined(ia64_HOST_ARCH)
3290 case R_IA64_DIR64LSB:
3291 case R_IA64_FPTR64LSB:
3294 case R_IA64_PCREL64LSB:
3297 case R_IA64_SEGREL64LSB:
3298 addr = findElfSegment(ehdrC, value);
3301 case R_IA64_GPREL22:
3302 ia64_reloc_gprel22(P, value);
3304 case R_IA64_LTOFF22:
3305 case R_IA64_LTOFF22X:
3306 case R_IA64_LTOFF_FPTR22:
3307 addr = allocateGOTEntry(value);
3308 ia64_reloc_gprel22(P, addr);
3310 case R_IA64_PCREL21B:
3311 ia64_reloc_pcrel21(P, S, oc);
3314 /* This goes with R_IA64_LTOFF22X and points to the load to
3315 * convert into a move. We don't implement relaxation. */
3317 # elif defined(powerpc_HOST_ARCH)
3318 case R_PPC_ADDR16_LO:
3319 *(Elf32_Half*) P = value;
3322 case R_PPC_ADDR16_HI:
3323 *(Elf32_Half*) P = value >> 16;
3326 case R_PPC_ADDR16_HA:
3327 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3331 *(Elf32_Word *) P = value;
3335 *(Elf32_Word *) P = value - P;
3341 if( delta << 6 >> 6 != delta )
3343 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3346 if( value == 0 || delta << 6 >> 6 != delta )
3348 barf( "Unable to make ppcJumpIsland for #%d",
3354 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3355 | (delta & 0x3fffffc);
3359 #if x86_64_HOST_ARCH
3361 *(Elf64_Xword *)P = value;
3366 StgInt64 off = value - P;
3367 if (off >= 0x7fffffffL || off < -0x80000000L) {
3368 barf("R_X86_64_PC32 relocation out of range: %s = %p",
3371 *(Elf64_Word *)P = (Elf64_Word)off;
3376 if (value >= 0x7fffffffL) {
3377 barf("R_X86_64_32 relocation out of range: %s = %p\n",
3380 *(Elf64_Word *)P = (Elf64_Word)value;
3384 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3385 barf("R_X86_64_32S relocation out of range: %s = %p\n",
3388 *(Elf64_Sword *)P = (Elf64_Sword)value;
3393 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
3394 oc->fileName, (lnat)ELF_R_TYPE(info));
3403 ocResolve_ELF ( ObjectCode* oc )
3407 Elf_Sym* stab = NULL;
3408 char* ehdrC = (char*)(oc->image);
3409 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3410 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3412 /* first find "the" symbol table */
3413 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3415 /* also go find the string table */
3416 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3418 if (stab == NULL || strtab == NULL) {
3419 errorBelch("%s: can't find string or symbol table", oc->fileName);
3423 /* Process the relocation sections. */
3424 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3425 if (shdr[shnum].sh_type == SHT_REL) {
3426 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3427 shnum, stab, strtab );
3431 if (shdr[shnum].sh_type == SHT_RELA) {
3432 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3433 shnum, stab, strtab );
3438 /* Free the local symbol table; we won't need it again. */
3439 freeHashTable(oc->lochash, NULL);
3442 #if defined(powerpc_HOST_ARCH)
3443 ocFlushInstructionCache( oc );
3451 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3452 * at the front. The following utility functions pack and unpack instructions, and
3453 * take care of the most common relocations.
3456 #ifdef ia64_HOST_ARCH
3459 ia64_extract_instruction(Elf64_Xword *target)
3462 int slot = (Elf_Addr)target & 3;
3463 target = (Elf_Addr)target & ~3;
3471 return ((w1 >> 5) & 0x1ffffffffff);
3473 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3477 barf("ia64_extract_instruction: invalid slot %p", target);
3482 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3484 int slot = (Elf_Addr)target & 3;
3485 target = (Elf_Addr)target & ~3;
3490 *target |= value << 5;
3493 *target |= value << 46;
3494 *(target+1) |= value >> 18;
3497 *(target+1) |= value << 23;
3503 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3505 Elf64_Xword instruction;
3506 Elf64_Sxword rel_value;
3508 rel_value = value - gp_val;
3509 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3510 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3512 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3513 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3514 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3515 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3516 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3517 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3521 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3523 Elf64_Xword instruction;
3524 Elf64_Sxword rel_value;
3527 entry = allocatePLTEntry(value, oc);
3529 rel_value = (entry >> 4) - (target >> 4);
3530 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3531 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3533 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3534 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3535 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3536 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3542 * PowerPC ELF specifics
3545 #ifdef powerpc_HOST_ARCH
3547 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3553 ehdr = (Elf_Ehdr *) oc->image;
3554 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3556 for( i = 0; i < ehdr->e_shnum; i++ )
3557 if( shdr[i].sh_type == SHT_SYMTAB )
3560 if( i == ehdr->e_shnum )
3562 errorBelch( "This ELF file contains no symtab" );
3566 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3568 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3569 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3574 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3577 #endif /* powerpc */
3581 /* --------------------------------------------------------------------------
3583 * ------------------------------------------------------------------------*/
3585 #if defined(OBJFORMAT_MACHO)
3588 Support for MachO linking on Darwin/MacOS X
3589 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3591 I hereby formally apologize for the hackish nature of this code.
3592 Things that need to be done:
3593 *) implement ocVerifyImage_MachO
3594 *) add still more sanity checks.
3597 #ifdef powerpc_HOST_ARCH
3598 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3600 struct mach_header *header = (struct mach_header *) oc->image;
3601 struct load_command *lc = (struct load_command *) (header + 1);
3604 for( i = 0; i < header->ncmds; i++ )
3606 if( lc->cmd == LC_SYMTAB )
3608 // Find out the first and last undefined external
3609 // symbol, so we don't have to allocate too many
3611 struct symtab_command *symLC = (struct symtab_command *) lc;
3612 unsigned min = symLC->nsyms, max = 0;
3613 struct nlist *nlist =
3614 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3616 for(i=0;i<symLC->nsyms;i++)
3618 if(nlist[i].n_type & N_STAB)
3620 else if(nlist[i].n_type & N_EXT)
3622 if((nlist[i].n_type & N_TYPE) == N_UNDF
3623 && (nlist[i].n_value == 0))
3633 return ocAllocateJumpIslands(oc, max - min + 1, min);
3638 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3640 return ocAllocateJumpIslands(oc,0,0);
3644 static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
3646 // FIXME: do some verifying here
3650 static int resolveImports(
3653 struct symtab_command *symLC,
3654 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3655 unsigned long *indirectSyms,
3656 struct nlist *nlist)
3660 for(i=0;i*4<sect->size;i++)
3662 // according to otool, reserved1 contains the first index into the indirect symbol table
3663 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3664 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3667 if((symbol->n_type & N_TYPE) == N_UNDF
3668 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3669 addr = (void*) (symbol->n_value);
3670 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3673 addr = lookupSymbol(nm);
3676 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3680 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3681 ((void**)(image + sect->offset))[i] = addr;
3687 static unsigned long relocateAddress(
3690 struct section* sections,
3691 unsigned long address)
3694 for(i = 0; i < nSections; i++)
3696 if(sections[i].addr <= address
3697 && address < sections[i].addr + sections[i].size)
3699 return (unsigned long)oc->image
3700 + sections[i].offset + address - sections[i].addr;
3703 barf("Invalid Mach-O file:"
3704 "Address out of bounds while relocating object file");
3708 static int relocateSection(
3711 struct symtab_command *symLC, struct nlist *nlist,
3712 int nSections, struct section* sections, struct section *sect)
3714 struct relocation_info *relocs;
3717 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3719 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3721 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
3723 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
3727 relocs = (struct relocation_info*) (image + sect->reloff);
3731 if(relocs[i].r_address & R_SCATTERED)
3733 struct scattered_relocation_info *scat =
3734 (struct scattered_relocation_info*) &relocs[i];
3738 if(scat->r_length == 2)
3740 unsigned long word = 0;
3741 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3742 checkProddableBlock(oc,wordPtr);
3744 // Note on relocation types:
3745 // i386 uses the GENERIC_RELOC_* types,
3746 // while ppc uses special PPC_RELOC_* types.
3747 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
3748 // in both cases, all others are different.
3749 // Therefore, we use GENERIC_RELOC_VANILLA
3750 // and GENERIC_RELOC_PAIR instead of the PPC variants,
3751 // and use #ifdefs for the other types.
3753 // Step 1: Figure out what the relocated value should be
3754 if(scat->r_type == GENERIC_RELOC_VANILLA)
3756 word = *wordPtr + (unsigned long) relocateAddress(
3763 #ifdef powerpc_HOST_ARCH
3764 else if(scat->r_type == PPC_RELOC_SECTDIFF
3765 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3766 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3767 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3769 else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
3772 struct scattered_relocation_info *pair =
3773 (struct scattered_relocation_info*) &relocs[i+1];
3775 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
3776 barf("Invalid Mach-O file: "
3777 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
3779 word = (unsigned long)
3780 (relocateAddress(oc, nSections, sections, scat->r_value)
3781 - relocateAddress(oc, nSections, sections, pair->r_value));
3784 #ifdef powerpc_HOST_ARCH
3785 else if(scat->r_type == PPC_RELOC_HI16
3786 || scat->r_type == PPC_RELOC_LO16
3787 || scat->r_type == PPC_RELOC_HA16
3788 || scat->r_type == PPC_RELOC_LO14)
3789 { // these are generated by label+offset things
3790 struct relocation_info *pair = &relocs[i+1];
3791 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3792 barf("Invalid Mach-O file: "
3793 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3795 if(scat->r_type == PPC_RELOC_LO16)
3797 word = ((unsigned short*) wordPtr)[1];
3798 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3800 else if(scat->r_type == PPC_RELOC_LO14)
3802 barf("Unsupported Relocation: PPC_RELOC_LO14");
3803 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3804 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3806 else if(scat->r_type == PPC_RELOC_HI16)
3808 word = ((unsigned short*) wordPtr)[1] << 16;
3809 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3811 else if(scat->r_type == PPC_RELOC_HA16)
3813 word = ((unsigned short*) wordPtr)[1] << 16;
3814 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3818 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3825 continue; // ignore the others
3827 #ifdef powerpc_HOST_ARCH
3828 if(scat->r_type == GENERIC_RELOC_VANILLA
3829 || scat->r_type == PPC_RELOC_SECTDIFF)
3831 if(scat->r_type == GENERIC_RELOC_VANILLA
3832 || scat->r_type == GENERIC_RELOC_SECTDIFF)
3837 #ifdef powerpc_HOST_ARCH
3838 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3840 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3842 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3844 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3846 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3848 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3849 + ((word & (1<<15)) ? 1 : 0);
3855 continue; // FIXME: I hope it's OK to ignore all the others.
3859 struct relocation_info *reloc = &relocs[i];
3860 if(reloc->r_pcrel && !reloc->r_extern)
3863 if(reloc->r_length == 2)
3865 unsigned long word = 0;
3866 #ifdef powerpc_HOST_ARCH
3867 unsigned long jumpIsland = 0;
3868 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
3869 // to avoid warning and to catch
3873 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3874 checkProddableBlock(oc,wordPtr);
3876 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3880 #ifdef powerpc_HOST_ARCH
3881 else if(reloc->r_type == PPC_RELOC_LO16)
3883 word = ((unsigned short*) wordPtr)[1];
3884 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3886 else if(reloc->r_type == PPC_RELOC_HI16)
3888 word = ((unsigned short*) wordPtr)[1] << 16;
3889 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3891 else if(reloc->r_type == PPC_RELOC_HA16)
3893 word = ((unsigned short*) wordPtr)[1] << 16;
3894 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3896 else if(reloc->r_type == PPC_RELOC_BR24)
3899 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3903 if(!reloc->r_extern)
3906 sections[reloc->r_symbolnum-1].offset
3907 - sections[reloc->r_symbolnum-1].addr
3914 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3915 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3916 void *symbolAddress = lookupSymbol(nm);
3919 errorBelch("\nunknown symbol `%s'", nm);
3925 #ifdef powerpc_HOST_ARCH
3926 // In the .o file, this should be a relative jump to NULL
3927 // and we'll change it to a relative jump to the symbol
3928 ASSERT(-word == reloc->r_address);
3929 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress);
3932 offsetToJumpIsland = word + jumpIsland
3933 - (((long)image) + sect->offset - sect->addr);
3936 word += (unsigned long) symbolAddress
3937 - (((long)image) + sect->offset - sect->addr);
3941 word += (unsigned long) symbolAddress;
3945 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3950 #ifdef powerpc_HOST_ARCH
3951 else if(reloc->r_type == PPC_RELOC_LO16)
3953 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3956 else if(reloc->r_type == PPC_RELOC_HI16)
3958 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3961 else if(reloc->r_type == PPC_RELOC_HA16)
3963 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3964 + ((word & (1<<15)) ? 1 : 0);
3967 else if(reloc->r_type == PPC_RELOC_BR24)
3969 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3971 // The branch offset is too large.
3972 // Therefore, we try to use a jump island.
3975 barf("unconditional relative branch out of range: "
3976 "no jump island available");
3979 word = offsetToJumpIsland;
3980 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3981 barf("unconditional relative branch out of range: "
3982 "jump island out of range");
3984 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3989 barf("\nunknown relocation %d",reloc->r_type);
3996 static int ocGetNames_MachO(ObjectCode* oc)
3998 char *image = (char*) oc->image;
3999 struct mach_header *header = (struct mach_header*) image;
4000 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4001 unsigned i,curSymbol = 0;
4002 struct segment_command *segLC = NULL;
4003 struct section *sections;
4004 struct symtab_command *symLC = NULL;
4005 struct nlist *nlist;
4006 unsigned long commonSize = 0;
4007 char *commonStorage = NULL;
4008 unsigned long commonCounter;
4010 for(i=0;i<header->ncmds;i++)
4012 if(lc->cmd == LC_SEGMENT)
4013 segLC = (struct segment_command*) lc;
4014 else if(lc->cmd == LC_SYMTAB)
4015 symLC = (struct symtab_command*) lc;
4016 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4019 sections = (struct section*) (segLC+1);
4020 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4023 for(i=0;i<segLC->nsects;i++)
4025 if(sections[i].size == 0)
4028 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4030 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4031 "ocGetNames_MachO(common symbols)");
4032 sections[i].offset = zeroFillArea - image;
4035 if(!strcmp(sections[i].sectname,"__text"))
4036 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4037 (void*) (image + sections[i].offset),
4038 (void*) (image + sections[i].offset + sections[i].size));
4039 else if(!strcmp(sections[i].sectname,"__const"))
4040 addSection(oc, SECTIONKIND_RWDATA,
4041 (void*) (image + sections[i].offset),
4042 (void*) (image + sections[i].offset + sections[i].size));
4043 else if(!strcmp(sections[i].sectname,"__data"))
4044 addSection(oc, SECTIONKIND_RWDATA,
4045 (void*) (image + sections[i].offset),
4046 (void*) (image + sections[i].offset + sections[i].size));
4047 else if(!strcmp(sections[i].sectname,"__bss")
4048 || !strcmp(sections[i].sectname,"__common"))
4049 addSection(oc, SECTIONKIND_RWDATA,
4050 (void*) (image + sections[i].offset),
4051 (void*) (image + sections[i].offset + sections[i].size));
4053 addProddableBlock(oc, (void*) (image + sections[i].offset),
4057 // count external symbols defined here
4061 for(i=0;i<symLC->nsyms;i++)
4063 if(nlist[i].n_type & N_STAB)
4065 else if(nlist[i].n_type & N_EXT)
4067 if((nlist[i].n_type & N_TYPE) == N_UNDF
4068 && (nlist[i].n_value != 0))
4070 commonSize += nlist[i].n_value;
4073 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4078 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4079 "ocGetNames_MachO(oc->symbols)");
4083 for(i=0;i<symLC->nsyms;i++)
4085 if(nlist[i].n_type & N_STAB)
4087 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4089 if(nlist[i].n_type & N_EXT)
4091 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4092 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4094 + sections[nlist[i].n_sect-1].offset
4095 - sections[nlist[i].n_sect-1].addr
4096 + nlist[i].n_value);
4097 oc->symbols[curSymbol++] = nm;
4101 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4102 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
4104 + sections[nlist[i].n_sect-1].offset
4105 - sections[nlist[i].n_sect-1].addr
4106 + nlist[i].n_value);
4112 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4113 commonCounter = (unsigned long)commonStorage;
4116 for(i=0;i<symLC->nsyms;i++)
4118 if((nlist[i].n_type & N_TYPE) == N_UNDF
4119 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4121 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4122 unsigned long sz = nlist[i].n_value;
4124 nlist[i].n_value = commonCounter;
4126 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4127 (void*)commonCounter);
4128 oc->symbols[curSymbol++] = nm;
4130 commonCounter += sz;
4137 static int ocResolve_MachO(ObjectCode* oc)
4139 char *image = (char*) oc->image;
4140 struct mach_header *header = (struct mach_header*) image;
4141 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4143 struct segment_command *segLC = NULL;
4144 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
4145 struct symtab_command *symLC = NULL;
4146 struct dysymtab_command *dsymLC = NULL;
4147 struct nlist *nlist;
4149 for(i=0;i<header->ncmds;i++)
4151 if(lc->cmd == LC_SEGMENT)
4152 segLC = (struct segment_command*) lc;
4153 else if(lc->cmd == LC_SYMTAB)
4154 symLC = (struct symtab_command*) lc;
4155 else if(lc->cmd == LC_DYSYMTAB)
4156 dsymLC = (struct dysymtab_command*) lc;
4157 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4160 sections = (struct section*) (segLC+1);
4161 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4164 for(i=0;i<segLC->nsects;i++)
4166 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
4167 la_ptrs = §ions[i];
4168 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
4169 nl_ptrs = §ions[i];
4170 else if(!strcmp(sections[i].sectname,"__la_sym_ptr2"))
4171 la_ptrs = §ions[i];
4172 else if(!strcmp(sections[i].sectname,"__la_sym_ptr3"))
4173 la_ptrs = §ions[i];
4178 unsigned long *indirectSyms
4179 = (unsigned long*) (image + dsymLC->indirectsymoff);
4182 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
4185 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
4189 for(i=0;i<segLC->nsects;i++)
4191 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
4195 /* Free the local symbol table; we won't need it again. */
4196 freeHashTable(oc->lochash, NULL);
4199 #if defined (powerpc_HOST_ARCH)
4200 ocFlushInstructionCache( oc );
4206 #ifdef powerpc_HOST_ARCH
4208 * The Mach-O object format uses leading underscores. But not everywhere.
4209 * There is a small number of runtime support functions defined in
4210 * libcc_dynamic.a whose name does not have a leading underscore.
4211 * As a consequence, we can't get their address from C code.
4212 * We have to use inline assembler just to take the address of a function.
4216 static void machoInitSymbolsWithoutUnderscore()
4218 extern void* symbolsWithoutUnderscore[];
4219 void **p = symbolsWithoutUnderscore;
4220 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4224 __asm__ volatile(".long " # x);
4226 RTS_MACHO_NOUNDERLINE_SYMBOLS
4228 __asm__ volatile(".text");
4232 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4234 RTS_MACHO_NOUNDERLINE_SYMBOLS
4241 * Figure out by how much to shift the entire Mach-O file in memory
4242 * when loading so that its single segment ends up 16-byte-aligned
4244 static int machoGetMisalignment( FILE * f )
4246 struct mach_header header;
4249 fread(&header, sizeof(header), 1, f);
4252 if(header.magic != MH_MAGIC)
4255 misalignment = (header.sizeofcmds + sizeof(header))
4258 return misalignment ? (16 - misalignment) : 0;