1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2000-2004
7 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.h"
13 // Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h>.
23 #include "LinkerInternals.h"
28 #ifdef HAVE_SYS_TYPES_H
29 #include <sys/types.h>
35 #ifdef HAVE_SYS_STAT_H
39 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
40 #include <HaskellSupport/dlfcn.h>
41 #elif defined(HAVE_DLFCN_H)
45 #if defined(cygwin32_TARGET_OS)
50 #ifdef HAVE_SYS_TIME_H
54 #include <sys/fcntl.h>
55 #include <sys/termios.h>
56 #include <sys/utime.h>
57 #include <sys/utsname.h>
61 #if defined(ia64_TARGET_ARCH) || defined(openbsd_TARGET_OS)
66 #if defined(openbsd_TARGET_OS)
74 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
75 # define OBJFORMAT_ELF
76 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
77 # define OBJFORMAT_PEi386
80 #elif defined(darwin_TARGET_OS)
81 # include <mach-o/ppc/reloc.h>
82 # define OBJFORMAT_MACHO
83 # include <mach-o/loader.h>
84 # include <mach-o/nlist.h>
85 # include <mach-o/reloc.h>
86 # include <mach-o/dyld.h>
89 /* Hash table mapping symbol names to Symbol */
90 static /*Str*/HashTable *symhash;
92 /* List of currently loaded objects */
93 ObjectCode *objects = NULL; /* initially empty */
95 #if defined(OBJFORMAT_ELF)
96 static int ocVerifyImage_ELF ( ObjectCode* oc );
97 static int ocGetNames_ELF ( ObjectCode* oc );
98 static int ocResolve_ELF ( ObjectCode* oc );
99 #elif defined(OBJFORMAT_PEi386)
100 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
101 static int ocGetNames_PEi386 ( ObjectCode* oc );
102 static int ocResolve_PEi386 ( ObjectCode* oc );
103 #elif defined(OBJFORMAT_MACHO)
104 static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
105 static int ocVerifyImage_MachO ( ObjectCode* oc );
106 static int ocGetNames_MachO ( ObjectCode* oc );
107 static int ocResolve_MachO ( ObjectCode* oc );
109 static void machoInitSymbolsWithoutUnderscore( void );
112 /* -----------------------------------------------------------------------------
113 * Built-in symbols from the RTS
116 typedef struct _RtsSymbolVal {
123 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
125 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
126 SymX(makeStableNamezh_fast) \
127 SymX(finalizzeWeakzh_fast)
129 /* These are not available in GUM!!! -- HWL */
130 #define Maybe_ForeignObj
131 #define Maybe_Stable_Names
134 #if !defined (mingw32_TARGET_OS)
135 #define RTS_POSIX_ONLY_SYMBOLS \
136 SymX(stg_sig_install) \
140 #if defined (cygwin32_TARGET_OS)
141 #define RTS_MINGW_ONLY_SYMBOLS /**/
142 /* Don't have the ability to read import libs / archives, so
143 * we have to stupidly list a lot of what libcygwin.a
146 #define RTS_CYGWIN_ONLY_SYMBOLS \
224 #elif !defined(mingw32_TARGET_OS)
225 #define RTS_MINGW_ONLY_SYMBOLS /**/
226 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
227 #else /* defined(mingw32_TARGET_OS) */
228 #define RTS_POSIX_ONLY_SYMBOLS /**/
229 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
231 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
233 #define RTS_MINGW_EXTRA_SYMS \
234 Sym(_imp____mb_cur_max) \
237 #define RTS_MINGW_EXTRA_SYMS
240 /* These are statically linked from the mingw libraries into the ghc
241 executable, so we have to employ this hack. */
242 #define RTS_MINGW_ONLY_SYMBOLS \
243 SymX(asyncReadzh_fast) \
244 SymX(asyncWritezh_fast) \
245 SymX(asyncDoProczh_fast) \
257 SymX(getservbyname) \
258 SymX(getservbyport) \
259 SymX(getprotobynumber) \
260 SymX(getprotobyname) \
261 SymX(gethostbyname) \
262 SymX(gethostbyaddr) \
297 Sym(_imp___timezone) \
305 RTS_MINGW_EXTRA_SYMS \
310 # define MAIN_CAP_SYM SymX(MainCapability)
312 # define MAIN_CAP_SYM
315 #ifdef TABLES_NEXT_TO_CODE
316 #define RTS_RET_SYMBOLS /* nothing */
318 #define RTS_RET_SYMBOLS \
319 SymX(stg_enter_ret) \
320 SymX(stg_gc_fun_ret) \
328 SymX(stg_ap_pv_ret) \
329 SymX(stg_ap_pp_ret) \
330 SymX(stg_ap_ppv_ret) \
331 SymX(stg_ap_ppp_ret) \
332 SymX(stg_ap_pppv_ret) \
333 SymX(stg_ap_pppp_ret) \
334 SymX(stg_ap_ppppp_ret) \
335 SymX(stg_ap_pppppp_ret)
338 #define RTS_SYMBOLS \
342 SymX(stg_enter_info) \
343 SymX(stg_gc_void_info) \
344 SymX(__stg_gc_enter_1) \
345 SymX(stg_gc_noregs) \
346 SymX(stg_gc_unpt_r1_info) \
347 SymX(stg_gc_unpt_r1) \
348 SymX(stg_gc_unbx_r1_info) \
349 SymX(stg_gc_unbx_r1) \
350 SymX(stg_gc_f1_info) \
352 SymX(stg_gc_d1_info) \
354 SymX(stg_gc_l1_info) \
357 SymX(stg_gc_fun_info) \
359 SymX(stg_gc_gen_info) \
360 SymX(stg_gc_gen_hp) \
362 SymX(stg_gen_yield) \
363 SymX(stg_yield_noregs) \
364 SymX(stg_yield_to_interpreter) \
365 SymX(stg_gen_block) \
366 SymX(stg_block_noregs) \
368 SymX(stg_block_takemvar) \
369 SymX(stg_block_putmvar) \
370 SymX(stg_seq_frame_info) \
372 SymX(MallocFailHook) \
374 SymX(OutOfHeapHook) \
375 SymX(StackOverflowHook) \
376 SymX(__encodeDouble) \
377 SymX(__encodeFloat) \
381 SymX(__gmpz_cmp_si) \
382 SymX(__gmpz_cmp_ui) \
383 SymX(__gmpz_get_si) \
384 SymX(__gmpz_get_ui) \
385 SymX(__int_encodeDouble) \
386 SymX(__int_encodeFloat) \
387 SymX(andIntegerzh_fast) \
389 SymX(blockAsyncExceptionszh_fast) \
391 SymX(closure_flags) \
393 SymX(cmpIntegerzh_fast) \
394 SymX(cmpIntegerIntzh_fast) \
395 SymX(complementIntegerzh_fast) \
396 SymX(createAdjustor) \
397 SymX(decodeDoublezh_fast) \
398 SymX(decodeFloatzh_fast) \
401 SymX(deRefWeakzh_fast) \
402 SymX(deRefStablePtrzh_fast) \
403 SymX(divExactIntegerzh_fast) \
404 SymX(divModIntegerzh_fast) \
407 SymX(forkOS_createThread) \
408 SymX(freeHaskellFunctionPtr) \
409 SymX(freeStablePtr) \
410 SymX(gcdIntegerzh_fast) \
411 SymX(gcdIntegerIntzh_fast) \
412 SymX(gcdIntzh_fast) \
417 SymX(int2Integerzh_fast) \
418 SymX(integer2Intzh_fast) \
419 SymX(integer2Wordzh_fast) \
420 SymX(isCurrentThreadBoundzh_fast) \
421 SymX(isDoubleDenormalized) \
422 SymX(isDoubleInfinite) \
424 SymX(isDoubleNegativeZero) \
425 SymX(isEmptyMVarzh_fast) \
426 SymX(isFloatDenormalized) \
427 SymX(isFloatInfinite) \
429 SymX(isFloatNegativeZero) \
430 SymX(killThreadzh_fast) \
433 SymX(makeStablePtrzh_fast) \
434 SymX(minusIntegerzh_fast) \
435 SymX(mkApUpd0zh_fast) \
436 SymX(myThreadIdzh_fast) \
437 SymX(labelThreadzh_fast) \
438 SymX(newArrayzh_fast) \
439 SymX(newBCOzh_fast) \
440 SymX(newByteArrayzh_fast) \
441 SymX_redirect(newCAF, newDynCAF) \
442 SymX(newMVarzh_fast) \
443 SymX(newMutVarzh_fast) \
444 SymX(atomicModifyMutVarzh_fast) \
445 SymX(newPinnedByteArrayzh_fast) \
446 SymX(orIntegerzh_fast) \
448 SymX(performMajorGC) \
449 SymX(plusIntegerzh_fast) \
452 SymX(putMVarzh_fast) \
453 SymX(quotIntegerzh_fast) \
454 SymX(quotRemIntegerzh_fast) \
456 SymX(raiseIOzh_fast) \
457 SymX(remIntegerzh_fast) \
458 SymX(resetNonBlockingFd) \
462 SymX(rts_checkSchedStatus) \
465 SymX(rts_evalLazyIO) \
466 SymX(rts_evalStableIO) \
470 SymX(rts_getDouble) \
475 SymX(rts_getFunPtr) \
476 SymX(rts_getStablePtr) \
477 SymX(rts_getThreadId) \
479 SymX(rts_getWord32) \
492 SymX(rts_mkStablePtr) \
500 SymX(rtsSupportsBoundThreads) \
502 SymX(__hscore_get_saved_termios) \
503 SymX(__hscore_set_saved_termios) \
505 SymX(startupHaskell) \
506 SymX(shutdownHaskell) \
507 SymX(shutdownHaskellAndExit) \
508 SymX(stable_ptr_table) \
509 SymX(stackOverflow) \
510 SymX(stg_CAF_BLACKHOLE_info) \
511 SymX(stg_BLACKHOLE_BQ_info) \
512 SymX(awakenBlockedQueue) \
513 SymX(stg_CHARLIKE_closure) \
514 SymX(stg_EMPTY_MVAR_info) \
515 SymX(stg_IND_STATIC_info) \
516 SymX(stg_INTLIKE_closure) \
517 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
518 SymX(stg_WEAK_info) \
519 SymX(stg_ap_0_info) \
520 SymX(stg_ap_v_info) \
521 SymX(stg_ap_f_info) \
522 SymX(stg_ap_d_info) \
523 SymX(stg_ap_l_info) \
524 SymX(stg_ap_n_info) \
525 SymX(stg_ap_p_info) \
526 SymX(stg_ap_pv_info) \
527 SymX(stg_ap_pp_info) \
528 SymX(stg_ap_ppv_info) \
529 SymX(stg_ap_ppp_info) \
530 SymX(stg_ap_pppv_info) \
531 SymX(stg_ap_pppp_info) \
532 SymX(stg_ap_ppppp_info) \
533 SymX(stg_ap_pppppp_info) \
534 SymX(stg_ap_1_upd_info) \
535 SymX(stg_ap_2_upd_info) \
536 SymX(stg_ap_3_upd_info) \
537 SymX(stg_ap_4_upd_info) \
538 SymX(stg_ap_5_upd_info) \
539 SymX(stg_ap_6_upd_info) \
540 SymX(stg_ap_7_upd_info) \
542 SymX(stg_sel_0_upd_info) \
543 SymX(stg_sel_10_upd_info) \
544 SymX(stg_sel_11_upd_info) \
545 SymX(stg_sel_12_upd_info) \
546 SymX(stg_sel_13_upd_info) \
547 SymX(stg_sel_14_upd_info) \
548 SymX(stg_sel_15_upd_info) \
549 SymX(stg_sel_1_upd_info) \
550 SymX(stg_sel_2_upd_info) \
551 SymX(stg_sel_3_upd_info) \
552 SymX(stg_sel_4_upd_info) \
553 SymX(stg_sel_5_upd_info) \
554 SymX(stg_sel_6_upd_info) \
555 SymX(stg_sel_7_upd_info) \
556 SymX(stg_sel_8_upd_info) \
557 SymX(stg_sel_9_upd_info) \
558 SymX(stg_upd_frame_info) \
559 SymX(suspendThread) \
560 SymX(takeMVarzh_fast) \
561 SymX(timesIntegerzh_fast) \
562 SymX(tryPutMVarzh_fast) \
563 SymX(tryTakeMVarzh_fast) \
564 SymX(unblockAsyncExceptionszh_fast) \
566 SymX(unsafeThawArrayzh_fast) \
567 SymX(waitReadzh_fast) \
568 SymX(waitWritezh_fast) \
569 SymX(word2Integerzh_fast) \
570 SymX(xorIntegerzh_fast) \
573 #ifdef SUPPORT_LONG_LONGS
574 #define RTS_LONG_LONG_SYMS \
575 SymX(int64ToIntegerzh_fast) \
576 SymX(word64ToIntegerzh_fast)
578 #define RTS_LONG_LONG_SYMS /* nothing */
581 // 64-bit support functions in libgcc.a
582 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
583 #define RTS_LIBGCC_SYMBOLS \
592 #elif defined(ia64_TARGET_ARCH)
593 #define RTS_LIBGCC_SYMBOLS \
601 #define RTS_LIBGCC_SYMBOLS
604 #ifdef darwin_TARGET_OS
605 // Symbols that don't have a leading underscore
606 // on Mac OS X. They have to receive special treatment,
607 // see machoInitSymbolsWithoutUnderscore()
608 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
613 /* entirely bogus claims about types of these symbols */
614 #define Sym(vvv) extern void vvv(void);
615 #define SymX(vvv) /**/
616 #define SymX_redirect(vvv,xxx) /**/
620 RTS_POSIX_ONLY_SYMBOLS
621 RTS_MINGW_ONLY_SYMBOLS
622 RTS_CYGWIN_ONLY_SYMBOLS
628 #ifdef LEADING_UNDERSCORE
629 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
631 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
634 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
636 #define SymX(vvv) Sym(vvv)
638 // SymX_redirect allows us to redirect references to one symbol to
639 // another symbol. See newCAF/newDynCAF for an example.
640 #define SymX_redirect(vvv,xxx) \
641 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
644 static RtsSymbolVal rtsSyms[] = {
648 RTS_POSIX_ONLY_SYMBOLS
649 RTS_MINGW_ONLY_SYMBOLS
650 RTS_CYGWIN_ONLY_SYMBOLS
652 { 0, 0 } /* sentinel */
655 /* -----------------------------------------------------------------------------
656 * Insert symbols into hash tables, checking for duplicates.
658 static void ghciInsertStrHashTable ( char* obj_name,
664 if (lookupHashTable(table, (StgWord)key) == NULL)
666 insertStrHashTable(table, (StgWord)key, data);
671 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
673 "whilst processing object file\n"
675 "This could be caused by:\n"
676 " * Loading two different object files which export the same symbol\n"
677 " * Specifying the same object file twice on the GHCi command line\n"
678 " * An incorrect `package.conf' entry, causing some object to be\n"
680 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
689 /* -----------------------------------------------------------------------------
690 * initialize the object linker
694 static int linker_init_done = 0 ;
696 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
697 static void *dl_prog_handle;
700 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
701 #if defined(openbsd_TARGET_OS)
702 static void *dl_libc_handle;
710 /* Make initLinker idempotent, so we can call it
711 before evey relevant operation; that means we
712 don't need to initialise the linker separately */
713 if (linker_init_done == 1) { return; } else {
714 linker_init_done = 1;
717 symhash = allocStrHashTable();
719 /* populate the symbol table with stuff from the RTS */
720 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
721 ghciInsertStrHashTable("(GHCi built-in symbols)",
722 symhash, sym->lbl, sym->addr);
724 # if defined(OBJFORMAT_MACHO)
725 machoInitSymbolsWithoutUnderscore();
728 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
729 # if defined(RTLD_DEFAULT)
730 dl_prog_handle = RTLD_DEFAULT;
732 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
733 # if defined(openbsd_TARGET_OS)
734 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
736 # endif // RTLD_DEFAULT
740 /* -----------------------------------------------------------------------------
741 * Loading DLL or .so dynamic libraries
742 * -----------------------------------------------------------------------------
744 * Add a DLL from which symbols may be found. In the ELF case, just
745 * do RTLD_GLOBAL-style add, so no further messing around needs to
746 * happen in order that symbols in the loaded .so are findable --
747 * lookupSymbol() will subsequently see them by dlsym on the program's
748 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
750 * In the PEi386 case, open the DLLs and put handles to them in a
751 * linked list. When looking for a symbol, try all handles in the
752 * list. This means that we need to load even DLLs that are guaranteed
753 * to be in the ghc.exe image already, just so we can get a handle
754 * to give to loadSymbol, so that we can find the symbols. For such
755 * libraries, the LoadLibrary call should be a no-op except for returning
760 #if defined(OBJFORMAT_PEi386)
761 /* A record for storing handles into DLLs. */
766 struct _OpenedDLL* next;
771 /* A list thereof. */
772 static OpenedDLL* opened_dlls = NULL;
776 addDLL( char *dll_name )
778 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
779 /* ------------------- ELF DLL loader ------------------- */
785 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
788 /* dlopen failed; return a ptr to the error msg. */
790 if (errmsg == NULL) errmsg = "addDLL: unknown error";
797 # elif defined(OBJFORMAT_PEi386)
798 /* ------------------- Win32 DLL loader ------------------- */
806 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
808 /* See if we've already got it, and ignore if so. */
809 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
810 if (0 == strcmp(o_dll->name, dll_name))
814 /* The file name has no suffix (yet) so that we can try
815 both foo.dll and foo.drv
817 The documentation for LoadLibrary says:
818 If no file name extension is specified in the lpFileName
819 parameter, the default library extension .dll is
820 appended. However, the file name string can include a trailing
821 point character (.) to indicate that the module name has no
824 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
825 sprintf(buf, "%s.DLL", dll_name);
826 instance = LoadLibrary(buf);
827 if (instance == NULL) {
828 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
829 instance = LoadLibrary(buf);
830 if (instance == NULL) {
833 /* LoadLibrary failed; return a ptr to the error msg. */
834 return "addDLL: unknown error";
839 /* Add this DLL to the list of DLLs in which to search for symbols. */
840 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
841 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
842 strcpy(o_dll->name, dll_name);
843 o_dll->instance = instance;
844 o_dll->next = opened_dlls;
849 barf("addDLL: not implemented on this platform");
853 /* -----------------------------------------------------------------------------
854 * lookup a symbol in the hash table
857 lookupSymbol( char *lbl )
861 ASSERT(symhash != NULL);
862 val = lookupStrHashTable(symhash, lbl);
865 # if defined(OBJFORMAT_ELF)
866 # if defined(openbsd_TARGET_OS)
867 val = dlsym(dl_prog_handle, lbl);
868 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
869 # else /* not openbsd */
870 return dlsym(dl_prog_handle, lbl);
872 # elif defined(OBJFORMAT_MACHO)
873 if(NSIsSymbolNameDefined(lbl)) {
874 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
875 return NSAddressOfSymbol(symbol);
879 # elif defined(OBJFORMAT_PEi386)
882 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
883 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
885 /* HACK: if the name has an initial underscore, try stripping
886 it off & look that up first. I've yet to verify whether there's
887 a Rule that governs whether an initial '_' *should always* be
888 stripped off when mapping from import lib name to the DLL name.
890 sym = GetProcAddress(o_dll->instance, (lbl+1));
892 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
896 sym = GetProcAddress(o_dll->instance, lbl);
898 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
913 __attribute((unused))
915 lookupLocalSymbol( ObjectCode* oc, char *lbl )
919 val = lookupStrHashTable(oc->lochash, lbl);
929 /* -----------------------------------------------------------------------------
930 * Debugging aid: look in GHCi's object symbol tables for symbols
931 * within DELTA bytes of the specified address, and show their names.
934 void ghci_enquire ( char* addr );
936 void ghci_enquire ( char* addr )
941 const int DELTA = 64;
946 for (oc = objects; oc; oc = oc->next) {
947 for (i = 0; i < oc->n_symbols; i++) {
948 sym = oc->symbols[i];
949 if (sym == NULL) continue;
950 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
952 if (oc->lochash != NULL) {
953 a = lookupStrHashTable(oc->lochash, sym);
956 a = lookupStrHashTable(symhash, sym);
959 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
961 else if (addr-DELTA <= a && a <= addr+DELTA) {
962 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
969 #ifdef ia64_TARGET_ARCH
970 static unsigned int PLTSize(void);
973 /* -----------------------------------------------------------------------------
974 * Load an obj (populate the global symbol table, but don't resolve yet)
976 * Returns: 1 if ok, 0 on error.
979 loadObj( char *path )
986 void *map_addr = NULL;
993 /* fprintf(stderr, "loadObj %s\n", path ); */
995 /* Check that we haven't already loaded this object.
996 Ignore requests to load multiple times */
1000 for (o = objects; o; o = o->next) {
1001 if (0 == strcmp(o->fileName, path)) {
1003 break; /* don't need to search further */
1007 IF_DEBUG(linker, belch(
1008 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1009 "same object file twice:\n"
1011 "GHCi will ignore this, but be warned.\n"
1013 return 1; /* success */
1017 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1019 # if defined(OBJFORMAT_ELF)
1020 oc->formatName = "ELF";
1021 # elif defined(OBJFORMAT_PEi386)
1022 oc->formatName = "PEi386";
1023 # elif defined(OBJFORMAT_MACHO)
1024 oc->formatName = "Mach-O";
1027 barf("loadObj: not implemented on this platform");
1030 r = stat(path, &st);
1031 if (r == -1) { return 0; }
1033 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1034 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1035 strcpy(oc->fileName, path);
1037 oc->fileSize = st.st_size;
1039 oc->sections = NULL;
1040 oc->lochash = allocStrHashTable();
1041 oc->proddables = NULL;
1043 /* chain it onto the list of objects */
1048 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1050 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1052 #if defined(openbsd_TARGET_OS)
1053 fd = open(path, O_RDONLY, S_IRUSR);
1055 fd = open(path, O_RDONLY);
1058 barf("loadObj: can't open `%s'", path);
1060 pagesize = getpagesize();
1062 #ifdef ia64_TARGET_ARCH
1063 /* The PLT needs to be right before the object */
1064 n = ROUND_UP(PLTSize(), pagesize);
1065 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1066 if (oc->plt == MAP_FAILED)
1067 barf("loadObj: can't allocate PLT");
1070 map_addr = oc->plt + n;
1073 n = ROUND_UP(oc->fileSize, pagesize);
1074 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1075 if (oc->image == MAP_FAILED)
1076 barf("loadObj: can't map `%s'", path);
1080 #else /* !USE_MMAP */
1082 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1084 /* load the image into memory */
1085 f = fopen(path, "rb");
1087 barf("loadObj: can't read `%s'", path);
1089 n = fread ( oc->image, 1, oc->fileSize, f );
1090 if (n != oc->fileSize)
1091 barf("loadObj: error whilst reading `%s'", path);
1095 #endif /* USE_MMAP */
1097 # if defined(OBJFORMAT_MACHO)
1098 r = ocAllocateJumpIslands_MachO ( oc );
1099 if (!r) { return r; }
1102 /* verify the in-memory image */
1103 # if defined(OBJFORMAT_ELF)
1104 r = ocVerifyImage_ELF ( oc );
1105 # elif defined(OBJFORMAT_PEi386)
1106 r = ocVerifyImage_PEi386 ( oc );
1107 # elif defined(OBJFORMAT_MACHO)
1108 r = ocVerifyImage_MachO ( oc );
1110 barf("loadObj: no verify method");
1112 if (!r) { return r; }
1114 /* build the symbol list for this image */
1115 # if defined(OBJFORMAT_ELF)
1116 r = ocGetNames_ELF ( oc );
1117 # elif defined(OBJFORMAT_PEi386)
1118 r = ocGetNames_PEi386 ( oc );
1119 # elif defined(OBJFORMAT_MACHO)
1120 r = ocGetNames_MachO ( oc );
1122 barf("loadObj: no getNames method");
1124 if (!r) { return r; }
1126 /* loaded, but not resolved yet */
1127 oc->status = OBJECT_LOADED;
1132 /* -----------------------------------------------------------------------------
1133 * resolve all the currently unlinked objects in memory
1135 * Returns: 1 if ok, 0 on error.
1145 for (oc = objects; oc; oc = oc->next) {
1146 if (oc->status != OBJECT_RESOLVED) {
1147 # if defined(OBJFORMAT_ELF)
1148 r = ocResolve_ELF ( oc );
1149 # elif defined(OBJFORMAT_PEi386)
1150 r = ocResolve_PEi386 ( oc );
1151 # elif defined(OBJFORMAT_MACHO)
1152 r = ocResolve_MachO ( oc );
1154 barf("resolveObjs: not implemented on this platform");
1156 if (!r) { return r; }
1157 oc->status = OBJECT_RESOLVED;
1163 /* -----------------------------------------------------------------------------
1164 * delete an object from the pool
1167 unloadObj( char *path )
1169 ObjectCode *oc, *prev;
1171 ASSERT(symhash != NULL);
1172 ASSERT(objects != NULL);
1177 for (oc = objects; oc; prev = oc, oc = oc->next) {
1178 if (!strcmp(oc->fileName,path)) {
1180 /* Remove all the mappings for the symbols within this
1185 for (i = 0; i < oc->n_symbols; i++) {
1186 if (oc->symbols[i] != NULL) {
1187 removeStrHashTable(symhash, oc->symbols[i], NULL);
1195 prev->next = oc->next;
1198 /* We're going to leave this in place, in case there are
1199 any pointers from the heap into it: */
1200 /* stgFree(oc->image); */
1201 stgFree(oc->fileName);
1202 stgFree(oc->symbols);
1203 stgFree(oc->sections);
1204 /* The local hash table should have been freed at the end
1205 of the ocResolve_ call on it. */
1206 ASSERT(oc->lochash == NULL);
1212 belch("unloadObj: can't find `%s' to unload", path);
1216 /* -----------------------------------------------------------------------------
1217 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1218 * which may be prodded during relocation, and abort if we try and write
1219 * outside any of these.
1221 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1224 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1225 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1229 pb->next = oc->proddables;
1230 oc->proddables = pb;
1233 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1236 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1237 char* s = (char*)(pb->start);
1238 char* e = s + pb->size - 1;
1239 char* a = (char*)addr;
1240 /* Assumes that the biggest fixup involves a 4-byte write. This
1241 probably needs to be changed to 8 (ie, +7) on 64-bit
1243 if (a >= s && (a+3) <= e) return;
1245 barf("checkProddableBlock: invalid fixup in runtime linker");
1248 /* -----------------------------------------------------------------------------
1249 * Section management.
1251 static void addSection ( ObjectCode* oc, SectionKind kind,
1252 void* start, void* end )
1254 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1258 s->next = oc->sections;
1261 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1262 start, ((char*)end)-1, end - start + 1, kind );
1268 /* --------------------------------------------------------------------------
1269 * PEi386 specifics (Win32 targets)
1270 * ------------------------------------------------------------------------*/
1272 /* The information for this linker comes from
1273 Microsoft Portable Executable
1274 and Common Object File Format Specification
1275 revision 5.1 January 1998
1276 which SimonM says comes from the MS Developer Network CDs.
1278 It can be found there (on older CDs), but can also be found
1281 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1283 (this is Rev 6.0 from February 1999).
1285 Things move, so if that fails, try searching for it via
1287 http://www.google.com/search?q=PE+COFF+specification
1289 The ultimate reference for the PE format is the Winnt.h
1290 header file that comes with the Platform SDKs; as always,
1291 implementations will drift wrt their documentation.
1293 A good background article on the PE format is Matt Pietrek's
1294 March 1994 article in Microsoft System Journal (MSJ)
1295 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1296 Win32 Portable Executable File Format." The info in there
1297 has recently been updated in a two part article in
1298 MSDN magazine, issues Feb and March 2002,
1299 "Inside Windows: An In-Depth Look into the Win32 Portable
1300 Executable File Format"
1302 John Levine's book "Linkers and Loaders" contains useful
1307 #if defined(OBJFORMAT_PEi386)
1311 typedef unsigned char UChar;
1312 typedef unsigned short UInt16;
1313 typedef unsigned int UInt32;
1320 UInt16 NumberOfSections;
1321 UInt32 TimeDateStamp;
1322 UInt32 PointerToSymbolTable;
1323 UInt32 NumberOfSymbols;
1324 UInt16 SizeOfOptionalHeader;
1325 UInt16 Characteristics;
1329 #define sizeof_COFF_header 20
1336 UInt32 VirtualAddress;
1337 UInt32 SizeOfRawData;
1338 UInt32 PointerToRawData;
1339 UInt32 PointerToRelocations;
1340 UInt32 PointerToLinenumbers;
1341 UInt16 NumberOfRelocations;
1342 UInt16 NumberOfLineNumbers;
1343 UInt32 Characteristics;
1347 #define sizeof_COFF_section 40
1354 UInt16 SectionNumber;
1357 UChar NumberOfAuxSymbols;
1361 #define sizeof_COFF_symbol 18
1366 UInt32 VirtualAddress;
1367 UInt32 SymbolTableIndex;
1372 #define sizeof_COFF_reloc 10
1375 /* From PE spec doc, section 3.3.2 */
1376 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1377 windows.h -- for the same purpose, but I want to know what I'm
1379 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1380 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1381 #define MYIMAGE_FILE_DLL 0x2000
1382 #define MYIMAGE_FILE_SYSTEM 0x1000
1383 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1384 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1385 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1387 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1388 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1389 #define MYIMAGE_SYM_CLASS_STATIC 3
1390 #define MYIMAGE_SYM_UNDEFINED 0
1392 /* From PE spec doc, section 4.1 */
1393 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1394 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1395 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1397 /* From PE spec doc, section 5.2.1 */
1398 #define MYIMAGE_REL_I386_DIR32 0x0006
1399 #define MYIMAGE_REL_I386_REL32 0x0014
1402 /* We use myindex to calculate array addresses, rather than
1403 simply doing the normal subscript thing. That's because
1404 some of the above structs have sizes which are not
1405 a whole number of words. GCC rounds their sizes up to a
1406 whole number of words, which means that the address calcs
1407 arising from using normal C indexing or pointer arithmetic
1408 are just plain wrong. Sigh.
1411 myindex ( int scale, void* base, int index )
1414 ((UChar*)base) + scale * index;
1419 printName ( UChar* name, UChar* strtab )
1421 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1422 UInt32 strtab_offset = * (UInt32*)(name+4);
1423 fprintf ( stderr, "%s", strtab + strtab_offset );
1426 for (i = 0; i < 8; i++) {
1427 if (name[i] == 0) break;
1428 fprintf ( stderr, "%c", name[i] );
1435 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1437 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1438 UInt32 strtab_offset = * (UInt32*)(name+4);
1439 strncpy ( dst, strtab+strtab_offset, dstSize );
1445 if (name[i] == 0) break;
1455 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1458 /* If the string is longer than 8 bytes, look in the
1459 string table for it -- this will be correctly zero terminated.
1461 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1462 UInt32 strtab_offset = * (UInt32*)(name+4);
1463 return ((UChar*)strtab) + strtab_offset;
1465 /* Otherwise, if shorter than 8 bytes, return the original,
1466 which by defn is correctly terminated.
1468 if (name[7]==0) return name;
1469 /* The annoying case: 8 bytes. Copy into a temporary
1470 (which is never freed ...)
1472 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1474 strncpy(newstr,name,8);
1480 /* Just compares the short names (first 8 chars) */
1481 static COFF_section *
1482 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1486 = (COFF_header*)(oc->image);
1487 COFF_section* sectab
1489 ((UChar*)(oc->image))
1490 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1492 for (i = 0; i < hdr->NumberOfSections; i++) {
1495 COFF_section* section_i
1497 myindex ( sizeof_COFF_section, sectab, i );
1498 n1 = (UChar*) &(section_i->Name);
1500 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1501 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1502 n1[6]==n2[6] && n1[7]==n2[7])
1511 zapTrailingAtSign ( UChar* sym )
1513 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1515 if (sym[0] == 0) return;
1517 while (sym[i] != 0) i++;
1520 while (j > 0 && my_isdigit(sym[j])) j--;
1521 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1527 ocVerifyImage_PEi386 ( ObjectCode* oc )
1532 COFF_section* sectab;
1533 COFF_symbol* symtab;
1535 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1536 hdr = (COFF_header*)(oc->image);
1537 sectab = (COFF_section*) (
1538 ((UChar*)(oc->image))
1539 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1541 symtab = (COFF_symbol*) (
1542 ((UChar*)(oc->image))
1543 + hdr->PointerToSymbolTable
1545 strtab = ((UChar*)symtab)
1546 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1548 if (hdr->Machine != 0x14c) {
1549 belch("Not x86 PEi386");
1552 if (hdr->SizeOfOptionalHeader != 0) {
1553 belch("PEi386 with nonempty optional header");
1556 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1557 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1558 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1559 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1560 belch("Not a PEi386 object file");
1563 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1564 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1565 belch("Invalid PEi386 word size or endiannness: %d",
1566 (int)(hdr->Characteristics));
1569 /* If the string table size is way crazy, this might indicate that
1570 there are more than 64k relocations, despite claims to the
1571 contrary. Hence this test. */
1572 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1574 if ( (*(UInt32*)strtab) > 600000 ) {
1575 /* Note that 600k has no special significance other than being
1576 big enough to handle the almost-2MB-sized lumps that
1577 constitute HSwin32*.o. */
1578 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1583 /* No further verification after this point; only debug printing. */
1585 IF_DEBUG(linker, i=1);
1586 if (i == 0) return 1;
1589 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1591 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1593 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1595 fprintf ( stderr, "\n" );
1597 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1599 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1601 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1603 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1605 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1607 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1609 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1611 /* Print the section table. */
1612 fprintf ( stderr, "\n" );
1613 for (i = 0; i < hdr->NumberOfSections; i++) {
1615 COFF_section* sectab_i
1617 myindex ( sizeof_COFF_section, sectab, i );
1624 printName ( sectab_i->Name, strtab );
1634 sectab_i->VirtualSize,
1635 sectab_i->VirtualAddress,
1636 sectab_i->SizeOfRawData,
1637 sectab_i->PointerToRawData,
1638 sectab_i->NumberOfRelocations,
1639 sectab_i->PointerToRelocations,
1640 sectab_i->PointerToRawData
1642 reltab = (COFF_reloc*) (
1643 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1646 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1647 /* If the relocation field (a short) has overflowed, the
1648 * real count can be found in the first reloc entry.
1650 * See Section 4.1 (last para) of the PE spec (rev6.0).
1652 COFF_reloc* rel = (COFF_reloc*)
1653 myindex ( sizeof_COFF_reloc, reltab, 0 );
1654 noRelocs = rel->VirtualAddress;
1657 noRelocs = sectab_i->NumberOfRelocations;
1661 for (; j < noRelocs; j++) {
1663 COFF_reloc* rel = (COFF_reloc*)
1664 myindex ( sizeof_COFF_reloc, reltab, j );
1666 " type 0x%-4x vaddr 0x%-8x name `",
1668 rel->VirtualAddress );
1669 sym = (COFF_symbol*)
1670 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1671 /* Hmm..mysterious looking offset - what's it for? SOF */
1672 printName ( sym->Name, strtab -10 );
1673 fprintf ( stderr, "'\n" );
1676 fprintf ( stderr, "\n" );
1678 fprintf ( stderr, "\n" );
1679 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1680 fprintf ( stderr, "---START of string table---\n");
1681 for (i = 4; i < *(Int32*)strtab; i++) {
1683 fprintf ( stderr, "\n"); else
1684 fprintf( stderr, "%c", strtab[i] );
1686 fprintf ( stderr, "--- END of string table---\n");
1688 fprintf ( stderr, "\n" );
1691 COFF_symbol* symtab_i;
1692 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1693 symtab_i = (COFF_symbol*)
1694 myindex ( sizeof_COFF_symbol, symtab, i );
1700 printName ( symtab_i->Name, strtab );
1709 (Int32)(symtab_i->SectionNumber),
1710 (UInt32)symtab_i->Type,
1711 (UInt32)symtab_i->StorageClass,
1712 (UInt32)symtab_i->NumberOfAuxSymbols
1714 i += symtab_i->NumberOfAuxSymbols;
1718 fprintf ( stderr, "\n" );
1724 ocGetNames_PEi386 ( ObjectCode* oc )
1727 COFF_section* sectab;
1728 COFF_symbol* symtab;
1735 hdr = (COFF_header*)(oc->image);
1736 sectab = (COFF_section*) (
1737 ((UChar*)(oc->image))
1738 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1740 symtab = (COFF_symbol*) (
1741 ((UChar*)(oc->image))
1742 + hdr->PointerToSymbolTable
1744 strtab = ((UChar*)(oc->image))
1745 + hdr->PointerToSymbolTable
1746 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1748 /* Allocate space for any (local, anonymous) .bss sections. */
1750 for (i = 0; i < hdr->NumberOfSections; i++) {
1752 COFF_section* sectab_i
1754 myindex ( sizeof_COFF_section, sectab, i );
1755 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1756 if (sectab_i->VirtualSize == 0) continue;
1757 /* This is a non-empty .bss section. Allocate zeroed space for
1758 it, and set its PointerToRawData field such that oc->image +
1759 PointerToRawData == addr_of_zeroed_space. */
1760 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1761 "ocGetNames_PEi386(anonymous bss)");
1762 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1763 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1764 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1767 /* Copy section information into the ObjectCode. */
1769 for (i = 0; i < hdr->NumberOfSections; i++) {
1775 = SECTIONKIND_OTHER;
1776 COFF_section* sectab_i
1778 myindex ( sizeof_COFF_section, sectab, i );
1779 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1782 /* I'm sure this is the Right Way to do it. However, the
1783 alternative of testing the sectab_i->Name field seems to
1784 work ok with Cygwin.
1786 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1787 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1788 kind = SECTIONKIND_CODE_OR_RODATA;
1791 if (0==strcmp(".text",sectab_i->Name) ||
1792 0==strcmp(".rodata",sectab_i->Name))
1793 kind = SECTIONKIND_CODE_OR_RODATA;
1794 if (0==strcmp(".data",sectab_i->Name) ||
1795 0==strcmp(".bss",sectab_i->Name))
1796 kind = SECTIONKIND_RWDATA;
1798 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1799 sz = sectab_i->SizeOfRawData;
1800 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1802 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1803 end = start + sz - 1;
1805 if (kind == SECTIONKIND_OTHER
1806 /* Ignore sections called which contain stabs debugging
1808 && 0 != strcmp(".stab", sectab_i->Name)
1809 && 0 != strcmp(".stabstr", sectab_i->Name)
1811 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1815 if (kind != SECTIONKIND_OTHER && end >= start) {
1816 addSection(oc, kind, start, end);
1817 addProddableBlock(oc, start, end - start + 1);
1821 /* Copy exported symbols into the ObjectCode. */
1823 oc->n_symbols = hdr->NumberOfSymbols;
1824 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1825 "ocGetNames_PEi386(oc->symbols)");
1826 /* Call me paranoid; I don't care. */
1827 for (i = 0; i < oc->n_symbols; i++)
1828 oc->symbols[i] = NULL;
1832 COFF_symbol* symtab_i;
1833 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1834 symtab_i = (COFF_symbol*)
1835 myindex ( sizeof_COFF_symbol, symtab, i );
1839 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1840 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1841 /* This symbol is global and defined, viz, exported */
1842 /* for MYIMAGE_SYMCLASS_EXTERNAL
1843 && !MYIMAGE_SYM_UNDEFINED,
1844 the address of the symbol is:
1845 address of relevant section + offset in section
1847 COFF_section* sectabent
1848 = (COFF_section*) myindex ( sizeof_COFF_section,
1850 symtab_i->SectionNumber-1 );
1851 addr = ((UChar*)(oc->image))
1852 + (sectabent->PointerToRawData
1856 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1857 && symtab_i->Value > 0) {
1858 /* This symbol isn't in any section at all, ie, global bss.
1859 Allocate zeroed space for it. */
1860 addr = stgCallocBytes(1, symtab_i->Value,
1861 "ocGetNames_PEi386(non-anonymous bss)");
1862 addSection(oc, SECTIONKIND_RWDATA, addr,
1863 ((UChar*)addr) + symtab_i->Value - 1);
1864 addProddableBlock(oc, addr, symtab_i->Value);
1865 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1868 if (addr != NULL ) {
1869 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1870 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1871 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1872 ASSERT(i >= 0 && i < oc->n_symbols);
1873 /* cstring_from_COFF_symbol_name always succeeds. */
1874 oc->symbols[i] = sname;
1875 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1879 "IGNORING symbol %d\n"
1883 printName ( symtab_i->Name, strtab );
1892 (Int32)(symtab_i->SectionNumber),
1893 (UInt32)symtab_i->Type,
1894 (UInt32)symtab_i->StorageClass,
1895 (UInt32)symtab_i->NumberOfAuxSymbols
1900 i += symtab_i->NumberOfAuxSymbols;
1909 ocResolve_PEi386 ( ObjectCode* oc )
1912 COFF_section* sectab;
1913 COFF_symbol* symtab;
1923 /* ToDo: should be variable-sized? But is at least safe in the
1924 sense of buffer-overrun-proof. */
1926 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1928 hdr = (COFF_header*)(oc->image);
1929 sectab = (COFF_section*) (
1930 ((UChar*)(oc->image))
1931 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1933 symtab = (COFF_symbol*) (
1934 ((UChar*)(oc->image))
1935 + hdr->PointerToSymbolTable
1937 strtab = ((UChar*)(oc->image))
1938 + hdr->PointerToSymbolTable
1939 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1941 for (i = 0; i < hdr->NumberOfSections; i++) {
1942 COFF_section* sectab_i
1944 myindex ( sizeof_COFF_section, sectab, i );
1947 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1950 /* Ignore sections called which contain stabs debugging
1952 if (0 == strcmp(".stab", sectab_i->Name)
1953 || 0 == strcmp(".stabstr", sectab_i->Name))
1956 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1957 /* If the relocation field (a short) has overflowed, the
1958 * real count can be found in the first reloc entry.
1960 * See Section 4.1 (last para) of the PE spec (rev6.0).
1962 * Nov2003 update: the GNU linker still doesn't correctly
1963 * handle the generation of relocatable object files with
1964 * overflown relocations. Hence the output to warn of potential
1967 COFF_reloc* rel = (COFF_reloc*)
1968 myindex ( sizeof_COFF_reloc, reltab, 0 );
1969 noRelocs = rel->VirtualAddress;
1970 fprintf(stderr, "WARNING: Overflown relocation field (# relocs found: %u)\n", noRelocs); fflush(stderr);
1973 noRelocs = sectab_i->NumberOfRelocations;
1978 for (; j < noRelocs; j++) {
1980 COFF_reloc* reltab_j
1982 myindex ( sizeof_COFF_reloc, reltab, j );
1984 /* the location to patch */
1986 ((UChar*)(oc->image))
1987 + (sectab_i->PointerToRawData
1988 + reltab_j->VirtualAddress
1989 - sectab_i->VirtualAddress )
1991 /* the existing contents of pP */
1993 /* the symbol to connect to */
1994 sym = (COFF_symbol*)
1995 myindex ( sizeof_COFF_symbol,
1996 symtab, reltab_j->SymbolTableIndex );
1999 "reloc sec %2d num %3d: type 0x%-4x "
2000 "vaddr 0x%-8x name `",
2002 (UInt32)reltab_j->Type,
2003 reltab_j->VirtualAddress );
2004 printName ( sym->Name, strtab );
2005 fprintf ( stderr, "'\n" ));
2007 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2008 COFF_section* section_sym
2009 = findPEi386SectionCalled ( oc, sym->Name );
2011 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
2014 S = ((UInt32)(oc->image))
2015 + (section_sym->PointerToRawData
2018 copyName ( sym->Name, strtab, symbol, 1000-1 );
2019 (void*)S = lookupLocalSymbol( oc, symbol );
2020 if ((void*)S != NULL) goto foundit;
2021 (void*)S = lookupSymbol( symbol );
2022 if ((void*)S != NULL) goto foundit;
2023 zapTrailingAtSign ( symbol );
2024 (void*)S = lookupLocalSymbol( oc, symbol );
2025 if ((void*)S != NULL) goto foundit;
2026 (void*)S = lookupSymbol( symbol );
2027 if ((void*)S != NULL) goto foundit;
2028 /* Newline first because the interactive linker has printed "linking..." */
2029 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2033 checkProddableBlock(oc, pP);
2034 switch (reltab_j->Type) {
2035 case MYIMAGE_REL_I386_DIR32:
2038 case MYIMAGE_REL_I386_REL32:
2039 /* Tricky. We have to insert a displacement at
2040 pP which, when added to the PC for the _next_
2041 insn, gives the address of the target (S).
2042 Problem is to know the address of the next insn
2043 when we only know pP. We assume that this
2044 literal field is always the last in the insn,
2045 so that the address of the next insn is pP+4
2046 -- hence the constant 4.
2047 Also I don't know if A should be added, but so
2048 far it has always been zero.
2051 *pP = S - ((UInt32)pP) - 4;
2054 belch("%s: unhandled PEi386 relocation type %d",
2055 oc->fileName, reltab_j->Type);
2062 IF_DEBUG(linker, belch("completed %s", oc->fileName));
2066 #endif /* defined(OBJFORMAT_PEi386) */
2069 /* --------------------------------------------------------------------------
2071 * ------------------------------------------------------------------------*/
2073 #if defined(OBJFORMAT_ELF)
2078 #if defined(sparc_TARGET_ARCH)
2079 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2080 #elif defined(i386_TARGET_ARCH)
2081 # define ELF_TARGET_386 /* Used inside <elf.h> */
2082 #elif defined(x86_64_TARGET_ARCH)
2083 # define ELF_TARGET_X64_64
2085 #elif defined (ia64_TARGET_ARCH)
2086 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2088 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2089 # define ELF_NEED_GOT /* needs Global Offset Table */
2090 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2093 #if !defined(openbsd_TARGET_OS)
2096 /* openbsd elf has things in different places, with diff names */
2097 #include <elf_abi.h>
2098 #include <machine/reloc.h>
2099 #define R_386_32 RELOC_32
2100 #define R_386_PC32 RELOC_PC32
2104 * Define a set of types which can be used for both ELF32 and ELF64
2108 #define ELFCLASS ELFCLASS64
2109 #define Elf_Addr Elf64_Addr
2110 #define Elf_Word Elf64_Word
2111 #define Elf_Sword Elf64_Sword
2112 #define Elf_Ehdr Elf64_Ehdr
2113 #define Elf_Phdr Elf64_Phdr
2114 #define Elf_Shdr Elf64_Shdr
2115 #define Elf_Sym Elf64_Sym
2116 #define Elf_Rel Elf64_Rel
2117 #define Elf_Rela Elf64_Rela
2118 #define ELF_ST_TYPE ELF64_ST_TYPE
2119 #define ELF_ST_BIND ELF64_ST_BIND
2120 #define ELF_R_TYPE ELF64_R_TYPE
2121 #define ELF_R_SYM ELF64_R_SYM
2123 #define ELFCLASS ELFCLASS32
2124 #define Elf_Addr Elf32_Addr
2125 #define Elf_Word Elf32_Word
2126 #define Elf_Sword Elf32_Sword
2127 #define Elf_Ehdr Elf32_Ehdr
2128 #define Elf_Phdr Elf32_Phdr
2129 #define Elf_Shdr Elf32_Shdr
2130 #define Elf_Sym Elf32_Sym
2131 #define Elf_Rel Elf32_Rel
2132 #define Elf_Rela Elf32_Rela
2134 #define ELF_ST_TYPE ELF32_ST_TYPE
2137 #define ELF_ST_BIND ELF32_ST_BIND
2140 #define ELF_R_TYPE ELF32_R_TYPE
2143 #define ELF_R_SYM ELF32_R_SYM
2149 * Functions to allocate entries in dynamic sections. Currently we simply
2150 * preallocate a large number, and we don't check if a entry for the given
2151 * target already exists (a linear search is too slow). Ideally these
2152 * entries would be associated with symbols.
2155 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2156 #define GOT_SIZE 0x20000
2157 #define FUNCTION_TABLE_SIZE 0x10000
2158 #define PLT_SIZE 0x08000
2161 static Elf_Addr got[GOT_SIZE];
2162 static unsigned int gotIndex;
2163 static Elf_Addr gp_val = (Elf_Addr)got;
2166 allocateGOTEntry(Elf_Addr target)
2170 if (gotIndex >= GOT_SIZE)
2171 barf("Global offset table overflow");
2173 entry = &got[gotIndex++];
2175 return (Elf_Addr)entry;
2179 #ifdef ELF_FUNCTION_DESC
2185 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2186 static unsigned int functionTableIndex;
2189 allocateFunctionDesc(Elf_Addr target)
2191 FunctionDesc *entry;
2193 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2194 barf("Function table overflow");
2196 entry = &functionTable[functionTableIndex++];
2198 entry->gp = (Elf_Addr)gp_val;
2199 return (Elf_Addr)entry;
2203 copyFunctionDesc(Elf_Addr target)
2205 FunctionDesc *olddesc = (FunctionDesc *)target;
2206 FunctionDesc *newdesc;
2208 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2209 newdesc->gp = olddesc->gp;
2210 return (Elf_Addr)newdesc;
2215 #ifdef ia64_TARGET_ARCH
2216 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2217 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2219 static unsigned char plt_code[] =
2221 /* taken from binutils bfd/elfxx-ia64.c */
2222 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2223 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2224 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2225 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2226 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2227 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2230 /* If we can't get to the function descriptor via gp, take a local copy of it */
2231 #define PLT_RELOC(code, target) { \
2232 Elf64_Sxword rel_value = target - gp_val; \
2233 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2234 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2236 ia64_reloc_gprel22((Elf_Addr)code, target); \
2241 unsigned char code[sizeof(plt_code)];
2245 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2247 PLTEntry *plt = (PLTEntry *)oc->plt;
2250 if (oc->pltIndex >= PLT_SIZE)
2251 barf("Procedure table overflow");
2253 entry = &plt[oc->pltIndex++];
2254 memcpy(entry->code, plt_code, sizeof(entry->code));
2255 PLT_RELOC(entry->code, target);
2256 return (Elf_Addr)entry;
2262 return (PLT_SIZE * sizeof(PLTEntry));
2268 * Generic ELF functions
2272 findElfSection ( void* objImage, Elf_Word sh_type )
2274 char* ehdrC = (char*)objImage;
2275 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2276 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2277 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2281 for (i = 0; i < ehdr->e_shnum; i++) {
2282 if (shdr[i].sh_type == sh_type
2283 /* Ignore the section header's string table. */
2284 && i != ehdr->e_shstrndx
2285 /* Ignore string tables named .stabstr, as they contain
2287 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2289 ptr = ehdrC + shdr[i].sh_offset;
2296 #if defined(ia64_TARGET_ARCH)
2298 findElfSegment ( void* objImage, Elf_Addr vaddr )
2300 char* ehdrC = (char*)objImage;
2301 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2302 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2303 Elf_Addr segaddr = 0;
2306 for (i = 0; i < ehdr->e_phnum; i++) {
2307 segaddr = phdr[i].p_vaddr;
2308 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2316 ocVerifyImage_ELF ( ObjectCode* oc )
2320 int i, j, nent, nstrtab, nsymtabs;
2324 char* ehdrC = (char*)(oc->image);
2325 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2327 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2328 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2329 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2330 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2331 belch("%s: not an ELF object", oc->fileName);
2335 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2336 belch("%s: unsupported ELF format", oc->fileName);
2340 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2341 IF_DEBUG(linker,belch( "Is little-endian" ));
2343 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2344 IF_DEBUG(linker,belch( "Is big-endian" ));
2346 belch("%s: unknown endiannness", oc->fileName);
2350 if (ehdr->e_type != ET_REL) {
2351 belch("%s: not a relocatable object (.o) file", oc->fileName);
2354 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2356 IF_DEBUG(linker,belch( "Architecture is " ));
2357 switch (ehdr->e_machine) {
2358 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2359 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2361 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2363 default: IF_DEBUG(linker,belch( "unknown" ));
2364 belch("%s: unknown architecture", oc->fileName);
2368 IF_DEBUG(linker,belch(
2369 "\nSection header table: start %d, n_entries %d, ent_size %d",
2370 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2372 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2374 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2376 if (ehdr->e_shstrndx == SHN_UNDEF) {
2377 belch("%s: no section header string table", oc->fileName);
2380 IF_DEBUG(linker,belch( "Section header string table is section %d",
2382 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2385 for (i = 0; i < ehdr->e_shnum; i++) {
2386 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2387 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2388 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2389 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2390 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2391 ehdrC + shdr[i].sh_offset,
2392 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2394 if (shdr[i].sh_type == SHT_REL) {
2395 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2396 } else if (shdr[i].sh_type == SHT_RELA) {
2397 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2399 IF_DEBUG(linker,fprintf(stderr," "));
2402 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2406 IF_DEBUG(linker,belch( "\nString tables" ));
2409 for (i = 0; i < ehdr->e_shnum; i++) {
2410 if (shdr[i].sh_type == SHT_STRTAB
2411 /* Ignore the section header's string table. */
2412 && i != ehdr->e_shstrndx
2413 /* Ignore string tables named .stabstr, as they contain
2415 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2417 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2418 strtab = ehdrC + shdr[i].sh_offset;
2423 belch("%s: no string tables, or too many", oc->fileName);
2428 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2429 for (i = 0; i < ehdr->e_shnum; i++) {
2430 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2431 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2433 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2434 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2435 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2437 shdr[i].sh_size % sizeof(Elf_Sym)
2439 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2440 belch("%s: non-integral number of symbol table entries", oc->fileName);
2443 for (j = 0; j < nent; j++) {
2444 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2445 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2446 (int)stab[j].st_shndx,
2447 (int)stab[j].st_size,
2448 (char*)stab[j].st_value ));
2450 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2451 switch (ELF_ST_TYPE(stab[j].st_info)) {
2452 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2453 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2454 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2455 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2456 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2457 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2459 IF_DEBUG(linker,fprintf(stderr, " " ));
2461 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2462 switch (ELF_ST_BIND(stab[j].st_info)) {
2463 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2464 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2465 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2466 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2468 IF_DEBUG(linker,fprintf(stderr, " " ));
2470 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2474 if (nsymtabs == 0) {
2475 belch("%s: didn't find any symbol tables", oc->fileName);
2484 ocGetNames_ELF ( ObjectCode* oc )
2489 char* ehdrC = (char*)(oc->image);
2490 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2491 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2492 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2494 ASSERT(symhash != NULL);
2497 belch("%s: no strtab", oc->fileName);
2502 for (i = 0; i < ehdr->e_shnum; i++) {
2503 /* Figure out what kind of section it is. Logic derived from
2504 Figure 1.14 ("Special Sections") of the ELF document
2505 ("Portable Formats Specification, Version 1.1"). */
2506 Elf_Shdr hdr = shdr[i];
2507 SectionKind kind = SECTIONKIND_OTHER;
2510 if (hdr.sh_type == SHT_PROGBITS
2511 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2512 /* .text-style section */
2513 kind = SECTIONKIND_CODE_OR_RODATA;
2516 if (hdr.sh_type == SHT_PROGBITS
2517 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2518 /* .data-style section */
2519 kind = SECTIONKIND_RWDATA;
2522 if (hdr.sh_type == SHT_PROGBITS
2523 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2524 /* .rodata-style section */
2525 kind = SECTIONKIND_CODE_OR_RODATA;
2528 if (hdr.sh_type == SHT_NOBITS
2529 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2530 /* .bss-style section */
2531 kind = SECTIONKIND_RWDATA;
2535 if (is_bss && shdr[i].sh_size > 0) {
2536 /* This is a non-empty .bss section. Allocate zeroed space for
2537 it, and set its .sh_offset field such that
2538 ehdrC + .sh_offset == addr_of_zeroed_space. */
2539 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2540 "ocGetNames_ELF(BSS)");
2541 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2543 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2544 zspace, shdr[i].sh_size);
2548 /* fill in the section info */
2549 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2550 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2551 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2552 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2555 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2557 /* copy stuff into this module's object symbol table */
2558 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2559 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2561 oc->n_symbols = nent;
2562 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2563 "ocGetNames_ELF(oc->symbols)");
2565 for (j = 0; j < nent; j++) {
2567 char isLocal = FALSE; /* avoids uninit-var warning */
2569 char* nm = strtab + stab[j].st_name;
2570 int secno = stab[j].st_shndx;
2572 /* Figure out if we want to add it; if so, set ad to its
2573 address. Otherwise leave ad == NULL. */
2575 if (secno == SHN_COMMON) {
2577 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2579 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2580 stab[j].st_size, nm);
2582 /* Pointless to do addProddableBlock() for this area,
2583 since the linker should never poke around in it. */
2586 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2587 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2589 /* and not an undefined symbol */
2590 && stab[j].st_shndx != SHN_UNDEF
2591 /* and not in a "special section" */
2592 && stab[j].st_shndx < SHN_LORESERVE
2594 /* and it's a not a section or string table or anything silly */
2595 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2596 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2597 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2600 /* Section 0 is the undefined section, hence > and not >=. */
2601 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2603 if (shdr[secno].sh_type == SHT_NOBITS) {
2604 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2605 stab[j].st_size, stab[j].st_value, nm);
2608 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2609 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2612 #ifdef ELF_FUNCTION_DESC
2613 /* dlsym() and the initialisation table both give us function
2614 * descriptors, so to be consistent we store function descriptors
2615 * in the symbol table */
2616 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2617 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2619 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2620 ad, oc->fileName, nm ));
2625 /* And the decision is ... */
2629 oc->symbols[j] = nm;
2632 /* Ignore entirely. */
2634 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2638 IF_DEBUG(linker,belch( "skipping `%s'",
2639 strtab + stab[j].st_name ));
2642 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2643 (int)ELF_ST_BIND(stab[j].st_info),
2644 (int)ELF_ST_TYPE(stab[j].st_info),
2645 (int)stab[j].st_shndx,
2646 strtab + stab[j].st_name
2649 oc->symbols[j] = NULL;
2658 /* Do ELF relocations which lack an explicit addend. All x86-linux
2659 relocations appear to be of this form. */
2661 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2662 Elf_Shdr* shdr, int shnum,
2663 Elf_Sym* stab, char* strtab )
2668 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2669 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2670 int target_shndx = shdr[shnum].sh_info;
2671 int symtab_shndx = shdr[shnum].sh_link;
2673 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2674 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2675 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2676 target_shndx, symtab_shndx ));
2678 for (j = 0; j < nent; j++) {
2679 Elf_Addr offset = rtab[j].r_offset;
2680 Elf_Addr info = rtab[j].r_info;
2682 Elf_Addr P = ((Elf_Addr)targ) + offset;
2683 Elf_Word* pP = (Elf_Word*)P;
2689 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2690 j, (void*)offset, (void*)info ));
2692 IF_DEBUG(linker,belch( " ZERO" ));
2695 Elf_Sym sym = stab[ELF_R_SYM(info)];
2696 /* First see if it is a local symbol. */
2697 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2698 /* Yes, so we can get the address directly from the ELF symbol
2700 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2702 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2703 + stab[ELF_R_SYM(info)].st_value);
2706 /* No, so look up the name in our global table. */
2707 symbol = strtab + sym.st_name;
2708 S_tmp = lookupSymbol( symbol );
2709 S = (Elf_Addr)S_tmp;
2712 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2715 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2718 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2719 (void*)P, (void*)S, (void*)A ));
2720 checkProddableBlock ( oc, pP );
2724 switch (ELF_R_TYPE(info)) {
2725 # ifdef i386_TARGET_ARCH
2726 case R_386_32: *pP = value; break;
2727 case R_386_PC32: *pP = value - P; break;
2730 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2731 oc->fileName, ELF_R_TYPE(info));
2739 /* Do ELF relocations for which explicit addends are supplied.
2740 sparc-solaris relocations appear to be of this form. */
2742 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2743 Elf_Shdr* shdr, int shnum,
2744 Elf_Sym* stab, char* strtab )
2749 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2750 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2751 int target_shndx = shdr[shnum].sh_info;
2752 int symtab_shndx = shdr[shnum].sh_link;
2754 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2755 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2756 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2757 target_shndx, symtab_shndx ));
2759 for (j = 0; j < nent; j++) {
2760 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2761 /* This #ifdef only serves to avoid unused-var warnings. */
2762 Elf_Addr offset = rtab[j].r_offset;
2763 Elf_Addr P = targ + offset;
2765 Elf_Addr info = rtab[j].r_info;
2766 Elf_Addr A = rtab[j].r_addend;
2770 # if defined(sparc_TARGET_ARCH)
2771 Elf_Word* pP = (Elf_Word*)P;
2773 # elif defined(ia64_TARGET_ARCH)
2774 Elf64_Xword *pP = (Elf64_Xword *)P;
2778 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2779 j, (void*)offset, (void*)info,
2782 IF_DEBUG(linker,belch( " ZERO" ));
2785 Elf_Sym sym = stab[ELF_R_SYM(info)];
2786 /* First see if it is a local symbol. */
2787 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2788 /* Yes, so we can get the address directly from the ELF symbol
2790 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2792 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2793 + stab[ELF_R_SYM(info)].st_value);
2794 #ifdef ELF_FUNCTION_DESC
2795 /* Make a function descriptor for this function */
2796 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2797 S = allocateFunctionDesc(S + A);
2802 /* No, so look up the name in our global table. */
2803 symbol = strtab + sym.st_name;
2804 S_tmp = lookupSymbol( symbol );
2805 S = (Elf_Addr)S_tmp;
2807 #ifdef ELF_FUNCTION_DESC
2808 /* If a function, already a function descriptor - we would
2809 have to copy it to add an offset. */
2810 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2811 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2815 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2818 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2821 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2822 (void*)P, (void*)S, (void*)A ));
2823 /* checkProddableBlock ( oc, (void*)P ); */
2827 switch (ELF_R_TYPE(info)) {
2828 # if defined(sparc_TARGET_ARCH)
2829 case R_SPARC_WDISP30:
2830 w1 = *pP & 0xC0000000;
2831 w2 = (Elf_Word)((value - P) >> 2);
2832 ASSERT((w2 & 0xC0000000) == 0);
2837 w1 = *pP & 0xFFC00000;
2838 w2 = (Elf_Word)(value >> 10);
2839 ASSERT((w2 & 0xFFC00000) == 0);
2845 w2 = (Elf_Word)(value & 0x3FF);
2846 ASSERT((w2 & ~0x3FF) == 0);
2850 /* According to the Sun documentation:
2852 This relocation type resembles R_SPARC_32, except it refers to an
2853 unaligned word. That is, the word to be relocated must be treated
2854 as four separate bytes with arbitrary alignment, not as a word
2855 aligned according to the architecture requirements.
2857 (JRS: which means that freeloading on the R_SPARC_32 case
2858 is probably wrong, but hey ...)
2862 w2 = (Elf_Word)value;
2865 # elif defined(ia64_TARGET_ARCH)
2866 case R_IA64_DIR64LSB:
2867 case R_IA64_FPTR64LSB:
2870 case R_IA64_PCREL64LSB:
2873 case R_IA64_SEGREL64LSB:
2874 addr = findElfSegment(ehdrC, value);
2877 case R_IA64_GPREL22:
2878 ia64_reloc_gprel22(P, value);
2880 case R_IA64_LTOFF22:
2881 case R_IA64_LTOFF22X:
2882 case R_IA64_LTOFF_FPTR22:
2883 addr = allocateGOTEntry(value);
2884 ia64_reloc_gprel22(P, addr);
2886 case R_IA64_PCREL21B:
2887 ia64_reloc_pcrel21(P, S, oc);
2890 /* This goes with R_IA64_LTOFF22X and points to the load to
2891 * convert into a move. We don't implement relaxation. */
2895 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2896 oc->fileName, ELF_R_TYPE(info));
2905 ocResolve_ELF ( ObjectCode* oc )
2909 Elf_Sym* stab = NULL;
2910 char* ehdrC = (char*)(oc->image);
2911 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2912 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2913 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2915 /* first find "the" symbol table */
2916 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2918 /* also go find the string table */
2919 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2921 if (stab == NULL || strtab == NULL) {
2922 belch("%s: can't find string or symbol table", oc->fileName);
2926 /* Process the relocation sections. */
2927 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2929 /* Skip sections called ".rel.stab". These appear to contain
2930 relocation entries that, when done, make the stabs debugging
2931 info point at the right places. We ain't interested in all
2933 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2936 if (shdr[shnum].sh_type == SHT_REL ) {
2937 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2938 shnum, stab, strtab );
2942 if (shdr[shnum].sh_type == SHT_RELA) {
2943 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2944 shnum, stab, strtab );
2949 /* Free the local symbol table; we won't need it again. */
2950 freeHashTable(oc->lochash, NULL);
2958 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2959 * at the front. The following utility functions pack and unpack instructions, and
2960 * take care of the most common relocations.
2963 #ifdef ia64_TARGET_ARCH
2966 ia64_extract_instruction(Elf64_Xword *target)
2969 int slot = (Elf_Addr)target & 3;
2970 (Elf_Addr)target &= ~3;
2978 return ((w1 >> 5) & 0x1ffffffffff);
2980 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2984 barf("ia64_extract_instruction: invalid slot %p", target);
2989 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2991 int slot = (Elf_Addr)target & 3;
2992 (Elf_Addr)target &= ~3;
2997 *target |= value << 5;
3000 *target |= value << 46;
3001 *(target+1) |= value >> 18;
3004 *(target+1) |= value << 23;
3010 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3012 Elf64_Xword instruction;
3013 Elf64_Sxword rel_value;
3015 rel_value = value - gp_val;
3016 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3017 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3019 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3020 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3021 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3022 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3023 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3024 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3028 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3030 Elf64_Xword instruction;
3031 Elf64_Sxword rel_value;
3034 entry = allocatePLTEntry(value, oc);
3036 rel_value = (entry >> 4) - (target >> 4);
3037 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3038 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3040 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3041 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3042 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3043 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3050 /* --------------------------------------------------------------------------
3052 * ------------------------------------------------------------------------*/
3054 #if defined(OBJFORMAT_MACHO)
3057 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3058 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3060 I hereby formally apologize for the hackish nature of this code.
3061 Things that need to be done:
3062 *) implement ocVerifyImage_MachO
3063 *) add still more sanity checks.
3068 ocAllocateJumpIslands_MachO
3070 Allocate additional space at the end of the object file image to make room
3073 PowerPC relative branch instructions have a 24 bit displacement field.
3074 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
3075 If a particular imported symbol is outside this range, we have to redirect
3076 the jump to a short piece of new code that just loads the 32bit absolute
3077 address and jumps there.
3078 This function just allocates space for one 16 byte jump island for every
3079 undefined symbol in the object file. The code for the islands is filled in by
3080 makeJumpIsland below.
3083 static const int islandSize = 16;
3085 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3087 char *image = (char*) oc->image;
3088 struct mach_header *header = (struct mach_header*) image;
3089 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3092 for(i=0;i<header->ncmds;i++)
3094 if(lc->cmd == LC_DYSYMTAB)
3096 struct dysymtab_command *dsymLC = (struct dysymtab_command*) lc;
3097 unsigned long nundefsym = dsymLC->nundefsym;
3098 oc->island_start_symbol = dsymLC->iundefsym;
3099 oc->n_islands = nundefsym;
3104 #error ocAllocateJumpIslands_MachO doesnt want USE_MMAP to be defined
3106 oc->image = stgReallocBytes(
3107 image, oc->fileSize + islandSize * nundefsym,
3108 "ocAllocateJumpIslands_MachO");
3110 oc->jump_islands = oc->image + oc->fileSize;
3111 memset(oc->jump_islands, 0, islandSize * nundefsym);
3114 break; // there can be only one LC_DSYMTAB
3116 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3121 static int ocVerifyImage_MachO(ObjectCode* oc)
3123 // FIXME: do some verifying here
3127 static int resolveImports(
3130 struct symtab_command *symLC,
3131 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3132 unsigned long *indirectSyms,
3133 struct nlist *nlist)
3137 for(i=0;i*4<sect->size;i++)
3139 // according to otool, reserved1 contains the first index into the indirect symbol table
3140 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3141 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3144 if((symbol->n_type & N_TYPE) == N_UNDF
3145 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3146 addr = (void*) (symbol->n_value);
3147 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3150 addr = lookupSymbol(nm);
3153 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3157 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3158 ((void**)(image + sect->offset))[i] = addr;
3164 static void* makeJumpIsland(
3166 unsigned long symbolNumber,
3169 if(symbolNumber < oc->island_start_symbol ||
3170 symbolNumber - oc->island_start_symbol > oc->n_islands)
3172 symbolNumber -= oc->island_start_symbol;
3174 void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber);
3175 unsigned long *p = (unsigned long*) island;
3177 // lis r12, hi16(target)
3178 *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 );
3179 // ori r12, r12, lo16(target)
3180 *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF );
3186 return (void*) island;
3189 static char* relocateAddress(
3192 struct section* sections,
3193 unsigned long address)
3196 for(i = 0; i < nSections; i++)
3198 if(sections[i].addr <= address
3199 && address < sections[i].addr + sections[i].size)
3201 return oc->image + sections[i].offset + address - sections[i].addr;
3204 barf("Invalid Mach-O file:"
3205 "Address out of bounds while relocating object file");
3209 static int relocateSection(
3212 struct symtab_command *symLC, struct nlist *nlist,
3213 int nSections, struct section* sections, struct section *sect)
3215 struct relocation_info *relocs;
3218 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3220 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3224 relocs = (struct relocation_info*) (image + sect->reloff);
3228 if(relocs[i].r_address & R_SCATTERED)
3230 struct scattered_relocation_info *scat =
3231 (struct scattered_relocation_info*) &relocs[i];
3235 if(scat->r_length == 2)
3237 unsigned long word = 0;
3238 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3239 checkProddableBlock(oc,wordPtr);
3241 // Step 1: Figure out what the relocated value should be
3242 if(scat->r_type == GENERIC_RELOC_VANILLA)
3244 word = scat->r_value + sect->offset + ((long) image);
3246 else if(scat->r_type == PPC_RELOC_SECTDIFF
3247 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3248 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3249 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3251 struct scattered_relocation_info *pair =
3252 (struct scattered_relocation_info*) &relocs[i+1];
3254 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3255 barf("Invalid Mach-O file: "
3256 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3258 word = (unsigned long)
3259 (relocateAddress(oc, nSections, sections, scat->r_value)
3260 - relocateAddress(oc, nSections, sections, pair->r_value));
3263 else if(scat->r_type == PPC_RELOC_HI16
3264 || scat->r_type == PPC_RELOC_LO16
3265 || scat->r_type == PPC_RELOC_HA16
3266 || scat->r_type == PPC_RELOC_LO14)
3267 { // these are generated by label+offset things
3268 struct relocation_info *pair = &relocs[i+1];
3269 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3270 barf("Invalid Mach-O file: "
3271 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3273 if(scat->r_type == PPC_RELOC_LO16)
3275 word = ((unsigned short*) wordPtr)[1];
3276 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3278 else if(scat->r_type == PPC_RELOC_LO14)
3280 barf("Unsupported Relocation: PPC_RELOC_LO14");
3281 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3282 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3284 else if(scat->r_type == PPC_RELOC_HI16)
3286 word = ((unsigned short*) wordPtr)[1] << 16;
3287 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3289 else if(scat->r_type == PPC_RELOC_HA16)
3291 word = ((unsigned short*) wordPtr)[1] << 16;
3292 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3296 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3302 continue; // ignore the others
3304 if(scat->r_type == GENERIC_RELOC_VANILLA
3305 || scat->r_type == PPC_RELOC_SECTDIFF)
3309 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3311 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3313 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3315 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3317 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3319 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3320 + ((word & (1<<15)) ? 1 : 0);
3325 continue; // FIXME: I hope it's OK to ignore all the others.
3329 struct relocation_info *reloc = &relocs[i];
3330 if(reloc->r_pcrel && !reloc->r_extern)
3333 if(reloc->r_length == 2)
3335 unsigned long word = 0;
3336 unsigned long jumpIsland = 0;
3337 long offsetToJumpIsland;
3339 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3340 checkProddableBlock(oc,wordPtr);
3342 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3346 else if(reloc->r_type == PPC_RELOC_LO16)
3348 word = ((unsigned short*) wordPtr)[1];
3349 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3351 else if(reloc->r_type == PPC_RELOC_HI16)
3353 word = ((unsigned short*) wordPtr)[1] << 16;
3354 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3356 else if(reloc->r_type == PPC_RELOC_HA16)
3358 word = ((unsigned short*) wordPtr)[1] << 16;
3359 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3361 else if(reloc->r_type == PPC_RELOC_BR24)
3364 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3368 if(!reloc->r_extern)
3371 sections[reloc->r_symbolnum-1].offset
3372 - sections[reloc->r_symbolnum-1].addr
3379 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3380 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3381 unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
3384 belch("\nunknown symbol `%s'", nm);
3391 word = symbolAddress;
3392 jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
3393 word -= ((long)image) + sect->offset + reloc->r_address;
3396 offsetToJumpIsland = jumpIsland
3397 - (((long)image) + sect->offset + reloc->r_address);
3402 word += symbolAddress;
3406 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3411 else if(reloc->r_type == PPC_RELOC_LO16)
3413 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3416 else if(reloc->r_type == PPC_RELOC_HI16)
3418 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3421 else if(reloc->r_type == PPC_RELOC_HA16)
3423 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3424 + ((word & (1<<15)) ? 1 : 0);
3427 else if(reloc->r_type == PPC_RELOC_BR24)
3429 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3431 // The branch offset is too large.
3432 // Therefore, we try to use a jump island.
3434 barf("unconditional relative branch out of range: "
3435 "no jump island available");
3437 word = offsetToJumpIsland;
3438 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3439 barf("unconditional relative branch out of range: "
3440 "jump island out of range");
3442 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3446 barf("\nunknown relocation %d",reloc->r_type);
3453 static int ocGetNames_MachO(ObjectCode* oc)
3455 char *image = (char*) oc->image;
3456 struct mach_header *header = (struct mach_header*) image;
3457 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3458 unsigned i,curSymbol;
3459 struct segment_command *segLC = NULL;
3460 struct section *sections;
3461 struct symtab_command *symLC = NULL;
3462 struct dysymtab_command *dsymLC = NULL;
3463 struct nlist *nlist;
3464 unsigned long commonSize = 0;
3465 char *commonStorage = NULL;
3466 unsigned long commonCounter;
3468 for(i=0;i<header->ncmds;i++)
3470 if(lc->cmd == LC_SEGMENT)
3471 segLC = (struct segment_command*) lc;
3472 else if(lc->cmd == LC_SYMTAB)
3473 symLC = (struct symtab_command*) lc;
3474 else if(lc->cmd == LC_DYSYMTAB)
3475 dsymLC = (struct dysymtab_command*) lc;
3476 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3479 sections = (struct section*) (segLC+1);
3480 nlist = (struct nlist*) (image + symLC->symoff);
3482 for(i=0;i<segLC->nsects;i++)
3484 if(sections[i].size == 0)
3487 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3489 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3490 "ocGetNames_MachO(common symbols)");
3491 sections[i].offset = zeroFillArea - image;
3494 if(!strcmp(sections[i].sectname,"__text"))
3495 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3496 (void*) (image + sections[i].offset),
3497 (void*) (image + sections[i].offset + sections[i].size));
3498 else if(!strcmp(sections[i].sectname,"__const"))
3499 addSection(oc, SECTIONKIND_RWDATA,
3500 (void*) (image + sections[i].offset),
3501 (void*) (image + sections[i].offset + sections[i].size));
3502 else if(!strcmp(sections[i].sectname,"__data"))
3503 addSection(oc, SECTIONKIND_RWDATA,
3504 (void*) (image + sections[i].offset),
3505 (void*) (image + sections[i].offset + sections[i].size));
3506 else if(!strcmp(sections[i].sectname,"__bss")
3507 || !strcmp(sections[i].sectname,"__common"))
3508 addSection(oc, SECTIONKIND_RWDATA,
3509 (void*) (image + sections[i].offset),
3510 (void*) (image + sections[i].offset + sections[i].size));
3512 addProddableBlock(oc, (void*) (image + sections[i].offset),
3516 // count external symbols defined here
3518 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3520 if((nlist[i].n_type & N_TYPE) == N_SECT)
3523 for(i=0;i<symLC->nsyms;i++)
3525 if((nlist[i].n_type & N_TYPE) == N_UNDF
3526 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3528 commonSize += nlist[i].n_value;
3532 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3533 "ocGetNames_MachO(oc->symbols)");
3535 // insert symbols into hash table
3536 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3538 if((nlist[i].n_type & N_TYPE) == N_SECT)
3540 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3541 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3542 sections[nlist[i].n_sect-1].offset
3543 - sections[nlist[i].n_sect-1].addr
3544 + nlist[i].n_value);
3545 oc->symbols[curSymbol++] = nm;
3549 // insert local symbols into lochash
3550 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3552 if((nlist[i].n_type & N_TYPE) == N_SECT)
3554 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3555 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3556 sections[nlist[i].n_sect-1].offset
3557 - sections[nlist[i].n_sect-1].addr
3558 + nlist[i].n_value);
3563 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3564 commonCounter = (unsigned long)commonStorage;
3565 for(i=0;i<symLC->nsyms;i++)
3567 if((nlist[i].n_type & N_TYPE) == N_UNDF
3568 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3570 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3571 unsigned long sz = nlist[i].n_value;
3573 nlist[i].n_value = commonCounter;
3575 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3576 oc->symbols[curSymbol++] = nm;
3578 commonCounter += sz;
3584 static int ocResolve_MachO(ObjectCode* oc)
3586 char *image = (char*) oc->image;
3587 struct mach_header *header = (struct mach_header*) image;
3588 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3590 struct segment_command *segLC = NULL;
3591 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3592 struct symtab_command *symLC = NULL;
3593 struct dysymtab_command *dsymLC = NULL;
3594 struct nlist *nlist;
3595 unsigned long *indirectSyms;
3597 for(i=0;i<header->ncmds;i++)
3599 if(lc->cmd == LC_SEGMENT)
3600 segLC = (struct segment_command*) lc;
3601 else if(lc->cmd == LC_SYMTAB)
3602 symLC = (struct symtab_command*) lc;
3603 else if(lc->cmd == LC_DYSYMTAB)
3604 dsymLC = (struct dysymtab_command*) lc;
3605 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3608 sections = (struct section*) (segLC+1);
3609 nlist = (struct nlist*) (image + symLC->symoff);
3611 for(i=0;i<segLC->nsects;i++)
3613 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3614 la_ptrs = §ions[i];
3615 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3616 nl_ptrs = §ions[i];
3619 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3622 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3625 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3628 for(i=0;i<segLC->nsects;i++)
3630 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3634 /* Free the local symbol table; we won't need it again. */
3635 freeHashTable(oc->lochash, NULL);
3639 Flush the data & instruction caches.
3640 Because the PPC has split data/instruction caches, we have to
3641 do that whenever we modify code at runtime.
3644 int n = (oc->fileSize + islandSize * oc->n_islands) / 4;
3645 unsigned long *p = (unsigned long*)oc->image;
3648 __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
3652 __asm__ volatile ("sync\n\tisync");
3658 * The Mach-O object format uses leading underscores. But not everywhere.
3659 * There is a small number of runtime support functions defined in
3660 * libcc_dynamic.a whose name does not have a leading underscore.
3661 * As a consequence, we can't get their address from C code.
3662 * We have to use inline assembler just to take the address of a function.
3666 static void machoInitSymbolsWithoutUnderscore()
3672 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3673 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3675 RTS_MACHO_NOUNDERLINE_SYMBOLS