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) \
392 SymX(complementIntegerzh_fast) \
393 SymX(cmpIntegerzh_fast) \
394 SymX(cmpIntegerIntzh_fast) \
395 SymX(createAdjustor) \
396 SymX(decodeDoublezh_fast) \
397 SymX(decodeFloatzh_fast) \
400 SymX(deRefWeakzh_fast) \
401 SymX(deRefStablePtrzh_fast) \
402 SymX(divExactIntegerzh_fast) \
403 SymX(divModIntegerzh_fast) \
406 SymX(forkOS_createThread) \
407 SymX(freeHaskellFunctionPtr) \
408 SymX(freeStablePtr) \
409 SymX(gcdIntegerzh_fast) \
410 SymX(gcdIntegerIntzh_fast) \
411 SymX(gcdIntzh_fast) \
416 SymX(int2Integerzh_fast) \
417 SymX(integer2Intzh_fast) \
418 SymX(integer2Wordzh_fast) \
419 SymX(isCurrentThreadBoundzh_fast) \
420 SymX(isDoubleDenormalized) \
421 SymX(isDoubleInfinite) \
423 SymX(isDoubleNegativeZero) \
424 SymX(isEmptyMVarzh_fast) \
425 SymX(isFloatDenormalized) \
426 SymX(isFloatInfinite) \
428 SymX(isFloatNegativeZero) \
429 SymX(killThreadzh_fast) \
432 SymX(makeStablePtrzh_fast) \
433 SymX(minusIntegerzh_fast) \
434 SymX(mkApUpd0zh_fast) \
435 SymX(myThreadIdzh_fast) \
436 SymX(labelThreadzh_fast) \
437 SymX(newArrayzh_fast) \
438 SymX(newBCOzh_fast) \
439 SymX(newByteArrayzh_fast) \
440 SymX_redirect(newCAF, newDynCAF) \
441 SymX(newMVarzh_fast) \
442 SymX(newMutVarzh_fast) \
443 SymX(atomicModifyMutVarzh_fast) \
444 SymX(newPinnedByteArrayzh_fast) \
445 SymX(orIntegerzh_fast) \
447 SymX(performMajorGC) \
448 SymX(plusIntegerzh_fast) \
451 SymX(putMVarzh_fast) \
452 SymX(quotIntegerzh_fast) \
453 SymX(quotRemIntegerzh_fast) \
455 SymX(raiseIOzh_fast) \
456 SymX(remIntegerzh_fast) \
457 SymX(resetNonBlockingFd) \
461 SymX(rts_checkSchedStatus) \
464 SymX(rts_evalLazyIO) \
465 SymX(rts_evalStableIO) \
469 SymX(rts_getDouble) \
474 SymX(rts_getFunPtr) \
475 SymX(rts_getStablePtr) \
476 SymX(rts_getThreadId) \
478 SymX(rts_getWord32) \
491 SymX(rts_mkStablePtr) \
499 SymX(rtsSupportsBoundThreads) \
501 SymX(__hscore_get_saved_termios) \
502 SymX(__hscore_set_saved_termios) \
504 SymX(startupHaskell) \
505 SymX(shutdownHaskell) \
506 SymX(shutdownHaskellAndExit) \
507 SymX(stable_ptr_table) \
508 SymX(stackOverflow) \
509 SymX(stg_CAF_BLACKHOLE_info) \
510 SymX(stg_BLACKHOLE_BQ_info) \
511 SymX(awakenBlockedQueue) \
512 SymX(stg_CHARLIKE_closure) \
513 SymX(stg_EMPTY_MVAR_info) \
514 SymX(stg_IND_STATIC_info) \
515 SymX(stg_INTLIKE_closure) \
516 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
517 SymX(stg_WEAK_info) \
518 SymX(stg_ap_v_info) \
519 SymX(stg_ap_f_info) \
520 SymX(stg_ap_d_info) \
521 SymX(stg_ap_l_info) \
522 SymX(stg_ap_n_info) \
523 SymX(stg_ap_p_info) \
524 SymX(stg_ap_pv_info) \
525 SymX(stg_ap_pp_info) \
526 SymX(stg_ap_ppv_info) \
527 SymX(stg_ap_ppp_info) \
528 SymX(stg_ap_pppv_info) \
529 SymX(stg_ap_pppp_info) \
530 SymX(stg_ap_ppppp_info) \
531 SymX(stg_ap_pppppp_info) \
532 SymX(stg_ap_1_upd_info) \
533 SymX(stg_ap_2_upd_info) \
534 SymX(stg_ap_3_upd_info) \
535 SymX(stg_ap_4_upd_info) \
536 SymX(stg_ap_5_upd_info) \
537 SymX(stg_ap_6_upd_info) \
538 SymX(stg_ap_7_upd_info) \
540 SymX(stg_sel_0_upd_info) \
541 SymX(stg_sel_10_upd_info) \
542 SymX(stg_sel_11_upd_info) \
543 SymX(stg_sel_12_upd_info) \
544 SymX(stg_sel_13_upd_info) \
545 SymX(stg_sel_14_upd_info) \
546 SymX(stg_sel_15_upd_info) \
547 SymX(stg_sel_1_upd_info) \
548 SymX(stg_sel_2_upd_info) \
549 SymX(stg_sel_3_upd_info) \
550 SymX(stg_sel_4_upd_info) \
551 SymX(stg_sel_5_upd_info) \
552 SymX(stg_sel_6_upd_info) \
553 SymX(stg_sel_7_upd_info) \
554 SymX(stg_sel_8_upd_info) \
555 SymX(stg_sel_9_upd_info) \
556 SymX(stg_upd_frame_info) \
557 SymX(suspendThread) \
558 SymX(takeMVarzh_fast) \
559 SymX(timesIntegerzh_fast) \
560 SymX(tryPutMVarzh_fast) \
561 SymX(tryTakeMVarzh_fast) \
562 SymX(unblockAsyncExceptionszh_fast) \
564 SymX(unsafeThawArrayzh_fast) \
565 SymX(waitReadzh_fast) \
566 SymX(waitWritezh_fast) \
567 SymX(word2Integerzh_fast) \
568 SymX(xorIntegerzh_fast) \
571 #ifdef SUPPORT_LONG_LONGS
572 #define RTS_LONG_LONG_SYMS \
573 SymX(int64ToIntegerzh_fast) \
574 SymX(word64ToIntegerzh_fast)
576 #define RTS_LONG_LONG_SYMS /* nothing */
579 // 64-bit support functions in libgcc.a
580 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
581 #define RTS_LIBGCC_SYMBOLS \
590 #elif defined(ia64_TARGET_ARCH)
591 #define RTS_LIBGCC_SYMBOLS \
599 #define RTS_LIBGCC_SYMBOLS
602 #ifdef darwin_TARGET_OS
603 // Symbols that don't have a leading underscore
604 // on Mac OS X. They have to receive special treatment,
605 // see machoInitSymbolsWithoutUnderscore()
606 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
611 /* entirely bogus claims about types of these symbols */
612 #define Sym(vvv) extern void vvv(void);
613 #define SymX(vvv) /**/
614 #define SymX_redirect(vvv,xxx) /**/
618 RTS_POSIX_ONLY_SYMBOLS
619 RTS_MINGW_ONLY_SYMBOLS
620 RTS_CYGWIN_ONLY_SYMBOLS
626 #ifdef LEADING_UNDERSCORE
627 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
629 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
632 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
634 #define SymX(vvv) Sym(vvv)
636 // SymX_redirect allows us to redirect references to one symbol to
637 // another symbol. See newCAF/newDynCAF for an example.
638 #define SymX_redirect(vvv,xxx) \
639 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
642 static RtsSymbolVal rtsSyms[] = {
645 RTS_POSIX_ONLY_SYMBOLS
646 RTS_MINGW_ONLY_SYMBOLS
647 RTS_CYGWIN_ONLY_SYMBOLS
649 { 0, 0 } /* sentinel */
652 /* -----------------------------------------------------------------------------
653 * Insert symbols into hash tables, checking for duplicates.
655 static void ghciInsertStrHashTable ( char* obj_name,
661 if (lookupHashTable(table, (StgWord)key) == NULL)
663 insertStrHashTable(table, (StgWord)key, data);
668 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
670 "whilst processing object file\n"
672 "This could be caused by:\n"
673 " * Loading two different object files which export the same symbol\n"
674 " * Specifying the same object file twice on the GHCi command line\n"
675 " * An incorrect `package.conf' entry, causing some object to be\n"
677 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
686 /* -----------------------------------------------------------------------------
687 * initialize the object linker
691 static int linker_init_done = 0 ;
693 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
694 static void *dl_prog_handle;
697 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
698 #if defined(openbsd_TARGET_OS)
699 static void *dl_libc_handle;
707 /* Make initLinker idempotent, so we can call it
708 before evey relevant operation; that means we
709 don't need to initialise the linker separately */
710 if (linker_init_done == 1) { return; } else {
711 linker_init_done = 1;
714 symhash = allocStrHashTable();
716 /* populate the symbol table with stuff from the RTS */
717 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
718 ghciInsertStrHashTable("(GHCi built-in symbols)",
719 symhash, sym->lbl, sym->addr);
721 # if defined(OBJFORMAT_MACHO)
722 machoInitSymbolsWithoutUnderscore();
725 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
726 # if defined(RTLD_DEFAULT)
727 dl_prog_handle = RTLD_DEFAULT;
729 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
730 # if defined(openbsd_TARGET_OS)
731 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
733 # endif // RTLD_DEFAULT
737 /* -----------------------------------------------------------------------------
738 * Loading DLL or .so dynamic libraries
739 * -----------------------------------------------------------------------------
741 * Add a DLL from which symbols may be found. In the ELF case, just
742 * do RTLD_GLOBAL-style add, so no further messing around needs to
743 * happen in order that symbols in the loaded .so are findable --
744 * lookupSymbol() will subsequently see them by dlsym on the program's
745 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
747 * In the PEi386 case, open the DLLs and put handles to them in a
748 * linked list. When looking for a symbol, try all handles in the
749 * list. This means that we need to load even DLLs that are guaranteed
750 * to be in the ghc.exe image already, just so we can get a handle
751 * to give to loadSymbol, so that we can find the symbols. For such
752 * libraries, the LoadLibrary call should be a no-op except for returning
757 #if defined(OBJFORMAT_PEi386)
758 /* A record for storing handles into DLLs. */
763 struct _OpenedDLL* next;
768 /* A list thereof. */
769 static OpenedDLL* opened_dlls = NULL;
773 addDLL( char *dll_name )
775 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
776 /* ------------------- ELF DLL loader ------------------- */
782 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
785 /* dlopen failed; return a ptr to the error msg. */
787 if (errmsg == NULL) errmsg = "addDLL: unknown error";
794 # elif defined(OBJFORMAT_PEi386)
795 /* ------------------- Win32 DLL loader ------------------- */
803 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
805 /* See if we've already got it, and ignore if so. */
806 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
807 if (0 == strcmp(o_dll->name, dll_name))
811 /* The file name has no suffix (yet) so that we can try
812 both foo.dll and foo.drv
814 The documentation for LoadLibrary says:
815 If no file name extension is specified in the lpFileName
816 parameter, the default library extension .dll is
817 appended. However, the file name string can include a trailing
818 point character (.) to indicate that the module name has no
821 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
822 sprintf(buf, "%s.DLL", dll_name);
823 instance = LoadLibrary(buf);
824 if (instance == NULL) {
825 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
826 instance = LoadLibrary(buf);
827 if (instance == NULL) {
830 /* LoadLibrary failed; return a ptr to the error msg. */
831 return "addDLL: unknown error";
836 /* Add this DLL to the list of DLLs in which to search for symbols. */
837 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
838 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
839 strcpy(o_dll->name, dll_name);
840 o_dll->instance = instance;
841 o_dll->next = opened_dlls;
846 barf("addDLL: not implemented on this platform");
850 /* -----------------------------------------------------------------------------
851 * lookup a symbol in the hash table
854 lookupSymbol( char *lbl )
858 ASSERT(symhash != NULL);
859 val = lookupStrHashTable(symhash, lbl);
862 # if defined(OBJFORMAT_ELF)
863 # if defined(openbsd_TARGET_OS)
864 val = dlsym(dl_prog_handle, lbl);
865 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
866 # else /* not openbsd */
867 return dlsym(dl_prog_handle, lbl);
869 # elif defined(OBJFORMAT_MACHO)
870 if(NSIsSymbolNameDefined(lbl)) {
871 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
872 return NSAddressOfSymbol(symbol);
876 # elif defined(OBJFORMAT_PEi386)
879 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
880 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
882 /* HACK: if the name has an initial underscore, try stripping
883 it off & look that up first. I've yet to verify whether there's
884 a Rule that governs whether an initial '_' *should always* be
885 stripped off when mapping from import lib name to the DLL name.
887 sym = GetProcAddress(o_dll->instance, (lbl+1));
889 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
893 sym = GetProcAddress(o_dll->instance, lbl);
895 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
910 __attribute((unused))
912 lookupLocalSymbol( ObjectCode* oc, char *lbl )
916 val = lookupStrHashTable(oc->lochash, lbl);
926 /* -----------------------------------------------------------------------------
927 * Debugging aid: look in GHCi's object symbol tables for symbols
928 * within DELTA bytes of the specified address, and show their names.
931 void ghci_enquire ( char* addr );
933 void ghci_enquire ( char* addr )
938 const int DELTA = 64;
943 for (oc = objects; oc; oc = oc->next) {
944 for (i = 0; i < oc->n_symbols; i++) {
945 sym = oc->symbols[i];
946 if (sym == NULL) continue;
947 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
949 if (oc->lochash != NULL) {
950 a = lookupStrHashTable(oc->lochash, sym);
953 a = lookupStrHashTable(symhash, sym);
956 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
958 else if (addr-DELTA <= a && a <= addr+DELTA) {
959 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
966 #ifdef ia64_TARGET_ARCH
967 static unsigned int PLTSize(void);
970 /* -----------------------------------------------------------------------------
971 * Load an obj (populate the global symbol table, but don't resolve yet)
973 * Returns: 1 if ok, 0 on error.
976 loadObj( char *path )
983 void *map_addr = NULL;
990 /* fprintf(stderr, "loadObj %s\n", path ); */
992 /* Check that we haven't already loaded this object.
993 Ignore requests to load multiple times */
997 for (o = objects; o; o = o->next) {
998 if (0 == strcmp(o->fileName, path)) {
1000 break; /* don't need to search further */
1004 IF_DEBUG(linker, belch(
1005 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1006 "same object file twice:\n"
1008 "GHCi will ignore this, but be warned.\n"
1010 return 1; /* success */
1014 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1016 # if defined(OBJFORMAT_ELF)
1017 oc->formatName = "ELF";
1018 # elif defined(OBJFORMAT_PEi386)
1019 oc->formatName = "PEi386";
1020 # elif defined(OBJFORMAT_MACHO)
1021 oc->formatName = "Mach-O";
1024 barf("loadObj: not implemented on this platform");
1027 r = stat(path, &st);
1028 if (r == -1) { return 0; }
1030 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1031 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1032 strcpy(oc->fileName, path);
1034 oc->fileSize = st.st_size;
1036 oc->sections = NULL;
1037 oc->lochash = allocStrHashTable();
1038 oc->proddables = NULL;
1040 /* chain it onto the list of objects */
1045 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1047 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1049 #if defined(openbsd_TARGET_OS)
1050 fd = open(path, O_RDONLY, S_IRUSR);
1052 fd = open(path, O_RDONLY);
1055 barf("loadObj: can't open `%s'", path);
1057 pagesize = getpagesize();
1059 #ifdef ia64_TARGET_ARCH
1060 /* The PLT needs to be right before the object */
1061 n = ROUND_UP(PLTSize(), pagesize);
1062 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1063 if (oc->plt == MAP_FAILED)
1064 barf("loadObj: can't allocate PLT");
1067 map_addr = oc->plt + n;
1070 n = ROUND_UP(oc->fileSize, pagesize);
1071 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1072 if (oc->image == MAP_FAILED)
1073 barf("loadObj: can't map `%s'", path);
1077 #else /* !USE_MMAP */
1079 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1081 /* load the image into memory */
1082 f = fopen(path, "rb");
1084 barf("loadObj: can't read `%s'", path);
1086 n = fread ( oc->image, 1, oc->fileSize, f );
1087 if (n != oc->fileSize)
1088 barf("loadObj: error whilst reading `%s'", path);
1092 #endif /* USE_MMAP */
1094 # if defined(OBJFORMAT_MACHO)
1095 r = ocAllocateJumpIslands_MachO ( oc );
1096 if (!r) { return r; }
1099 /* verify the in-memory image */
1100 # if defined(OBJFORMAT_ELF)
1101 r = ocVerifyImage_ELF ( oc );
1102 # elif defined(OBJFORMAT_PEi386)
1103 r = ocVerifyImage_PEi386 ( oc );
1104 # elif defined(OBJFORMAT_MACHO)
1105 r = ocVerifyImage_MachO ( oc );
1107 barf("loadObj: no verify method");
1109 if (!r) { return r; }
1111 /* build the symbol list for this image */
1112 # if defined(OBJFORMAT_ELF)
1113 r = ocGetNames_ELF ( oc );
1114 # elif defined(OBJFORMAT_PEi386)
1115 r = ocGetNames_PEi386 ( oc );
1116 # elif defined(OBJFORMAT_MACHO)
1117 r = ocGetNames_MachO ( oc );
1119 barf("loadObj: no getNames method");
1121 if (!r) { return r; }
1123 /* loaded, but not resolved yet */
1124 oc->status = OBJECT_LOADED;
1129 /* -----------------------------------------------------------------------------
1130 * resolve all the currently unlinked objects in memory
1132 * Returns: 1 if ok, 0 on error.
1142 for (oc = objects; oc; oc = oc->next) {
1143 if (oc->status != OBJECT_RESOLVED) {
1144 # if defined(OBJFORMAT_ELF)
1145 r = ocResolve_ELF ( oc );
1146 # elif defined(OBJFORMAT_PEi386)
1147 r = ocResolve_PEi386 ( oc );
1148 # elif defined(OBJFORMAT_MACHO)
1149 r = ocResolve_MachO ( oc );
1151 barf("resolveObjs: not implemented on this platform");
1153 if (!r) { return r; }
1154 oc->status = OBJECT_RESOLVED;
1160 /* -----------------------------------------------------------------------------
1161 * delete an object from the pool
1164 unloadObj( char *path )
1166 ObjectCode *oc, *prev;
1168 ASSERT(symhash != NULL);
1169 ASSERT(objects != NULL);
1174 for (oc = objects; oc; prev = oc, oc = oc->next) {
1175 if (!strcmp(oc->fileName,path)) {
1177 /* Remove all the mappings for the symbols within this
1182 for (i = 0; i < oc->n_symbols; i++) {
1183 if (oc->symbols[i] != NULL) {
1184 removeStrHashTable(symhash, oc->symbols[i], NULL);
1192 prev->next = oc->next;
1195 /* We're going to leave this in place, in case there are
1196 any pointers from the heap into it: */
1197 /* stgFree(oc->image); */
1198 stgFree(oc->fileName);
1199 stgFree(oc->symbols);
1200 stgFree(oc->sections);
1201 /* The local hash table should have been freed at the end
1202 of the ocResolve_ call on it. */
1203 ASSERT(oc->lochash == NULL);
1209 belch("unloadObj: can't find `%s' to unload", path);
1213 /* -----------------------------------------------------------------------------
1214 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1215 * which may be prodded during relocation, and abort if we try and write
1216 * outside any of these.
1218 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1221 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1222 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1226 pb->next = oc->proddables;
1227 oc->proddables = pb;
1230 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1233 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1234 char* s = (char*)(pb->start);
1235 char* e = s + pb->size - 1;
1236 char* a = (char*)addr;
1237 /* Assumes that the biggest fixup involves a 4-byte write. This
1238 probably needs to be changed to 8 (ie, +7) on 64-bit
1240 if (a >= s && (a+3) <= e) return;
1242 barf("checkProddableBlock: invalid fixup in runtime linker");
1245 /* -----------------------------------------------------------------------------
1246 * Section management.
1248 static void addSection ( ObjectCode* oc, SectionKind kind,
1249 void* start, void* end )
1251 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1255 s->next = oc->sections;
1258 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1259 start, ((char*)end)-1, end - start + 1, kind );
1265 /* --------------------------------------------------------------------------
1266 * PEi386 specifics (Win32 targets)
1267 * ------------------------------------------------------------------------*/
1269 /* The information for this linker comes from
1270 Microsoft Portable Executable
1271 and Common Object File Format Specification
1272 revision 5.1 January 1998
1273 which SimonM says comes from the MS Developer Network CDs.
1275 It can be found there (on older CDs), but can also be found
1278 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1280 (this is Rev 6.0 from February 1999).
1282 Things move, so if that fails, try searching for it via
1284 http://www.google.com/search?q=PE+COFF+specification
1286 The ultimate reference for the PE format is the Winnt.h
1287 header file that comes with the Platform SDKs; as always,
1288 implementations will drift wrt their documentation.
1290 A good background article on the PE format is Matt Pietrek's
1291 March 1994 article in Microsoft System Journal (MSJ)
1292 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1293 Win32 Portable Executable File Format." The info in there
1294 has recently been updated in a two part article in
1295 MSDN magazine, issues Feb and March 2002,
1296 "Inside Windows: An In-Depth Look into the Win32 Portable
1297 Executable File Format"
1299 John Levine's book "Linkers and Loaders" contains useful
1304 #if defined(OBJFORMAT_PEi386)
1308 typedef unsigned char UChar;
1309 typedef unsigned short UInt16;
1310 typedef unsigned int UInt32;
1317 UInt16 NumberOfSections;
1318 UInt32 TimeDateStamp;
1319 UInt32 PointerToSymbolTable;
1320 UInt32 NumberOfSymbols;
1321 UInt16 SizeOfOptionalHeader;
1322 UInt16 Characteristics;
1326 #define sizeof_COFF_header 20
1333 UInt32 VirtualAddress;
1334 UInt32 SizeOfRawData;
1335 UInt32 PointerToRawData;
1336 UInt32 PointerToRelocations;
1337 UInt32 PointerToLinenumbers;
1338 UInt16 NumberOfRelocations;
1339 UInt16 NumberOfLineNumbers;
1340 UInt32 Characteristics;
1344 #define sizeof_COFF_section 40
1351 UInt16 SectionNumber;
1354 UChar NumberOfAuxSymbols;
1358 #define sizeof_COFF_symbol 18
1363 UInt32 VirtualAddress;
1364 UInt32 SymbolTableIndex;
1369 #define sizeof_COFF_reloc 10
1372 /* From PE spec doc, section 3.3.2 */
1373 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1374 windows.h -- for the same purpose, but I want to know what I'm
1376 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1377 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1378 #define MYIMAGE_FILE_DLL 0x2000
1379 #define MYIMAGE_FILE_SYSTEM 0x1000
1380 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1381 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1382 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1384 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1385 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1386 #define MYIMAGE_SYM_CLASS_STATIC 3
1387 #define MYIMAGE_SYM_UNDEFINED 0
1389 /* From PE spec doc, section 4.1 */
1390 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1391 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1392 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1394 /* From PE spec doc, section 5.2.1 */
1395 #define MYIMAGE_REL_I386_DIR32 0x0006
1396 #define MYIMAGE_REL_I386_REL32 0x0014
1399 /* We use myindex to calculate array addresses, rather than
1400 simply doing the normal subscript thing. That's because
1401 some of the above structs have sizes which are not
1402 a whole number of words. GCC rounds their sizes up to a
1403 whole number of words, which means that the address calcs
1404 arising from using normal C indexing or pointer arithmetic
1405 are just plain wrong. Sigh.
1408 myindex ( int scale, void* base, int index )
1411 ((UChar*)base) + scale * index;
1416 printName ( UChar* name, UChar* strtab )
1418 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1419 UInt32 strtab_offset = * (UInt32*)(name+4);
1420 fprintf ( stderr, "%s", strtab + strtab_offset );
1423 for (i = 0; i < 8; i++) {
1424 if (name[i] == 0) break;
1425 fprintf ( stderr, "%c", name[i] );
1432 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1434 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1435 UInt32 strtab_offset = * (UInt32*)(name+4);
1436 strncpy ( dst, strtab+strtab_offset, dstSize );
1442 if (name[i] == 0) break;
1452 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1455 /* If the string is longer than 8 bytes, look in the
1456 string table for it -- this will be correctly zero terminated.
1458 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1459 UInt32 strtab_offset = * (UInt32*)(name+4);
1460 return ((UChar*)strtab) + strtab_offset;
1462 /* Otherwise, if shorter than 8 bytes, return the original,
1463 which by defn is correctly terminated.
1465 if (name[7]==0) return name;
1466 /* The annoying case: 8 bytes. Copy into a temporary
1467 (which is never freed ...)
1469 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1471 strncpy(newstr,name,8);
1477 /* Just compares the short names (first 8 chars) */
1478 static COFF_section *
1479 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1483 = (COFF_header*)(oc->image);
1484 COFF_section* sectab
1486 ((UChar*)(oc->image))
1487 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1489 for (i = 0; i < hdr->NumberOfSections; i++) {
1492 COFF_section* section_i
1494 myindex ( sizeof_COFF_section, sectab, i );
1495 n1 = (UChar*) &(section_i->Name);
1497 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1498 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1499 n1[6]==n2[6] && n1[7]==n2[7])
1508 zapTrailingAtSign ( UChar* sym )
1510 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1512 if (sym[0] == 0) return;
1514 while (sym[i] != 0) i++;
1517 while (j > 0 && my_isdigit(sym[j])) j--;
1518 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1524 ocVerifyImage_PEi386 ( ObjectCode* oc )
1529 COFF_section* sectab;
1530 COFF_symbol* symtab;
1532 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1533 hdr = (COFF_header*)(oc->image);
1534 sectab = (COFF_section*) (
1535 ((UChar*)(oc->image))
1536 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1538 symtab = (COFF_symbol*) (
1539 ((UChar*)(oc->image))
1540 + hdr->PointerToSymbolTable
1542 strtab = ((UChar*)symtab)
1543 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1545 if (hdr->Machine != 0x14c) {
1546 belch("Not x86 PEi386");
1549 if (hdr->SizeOfOptionalHeader != 0) {
1550 belch("PEi386 with nonempty optional header");
1553 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1554 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1555 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1556 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1557 belch("Not a PEi386 object file");
1560 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1561 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1562 belch("Invalid PEi386 word size or endiannness: %d",
1563 (int)(hdr->Characteristics));
1566 /* If the string table size is way crazy, this might indicate that
1567 there are more than 64k relocations, despite claims to the
1568 contrary. Hence this test. */
1569 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1571 if ( (*(UInt32*)strtab) > 600000 ) {
1572 /* Note that 600k has no special significance other than being
1573 big enough to handle the almost-2MB-sized lumps that
1574 constitute HSwin32*.o. */
1575 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1580 /* No further verification after this point; only debug printing. */
1582 IF_DEBUG(linker, i=1);
1583 if (i == 0) return 1;
1586 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1588 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1590 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1592 fprintf ( stderr, "\n" );
1594 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1596 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1598 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1600 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1602 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1604 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1606 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1608 /* Print the section table. */
1609 fprintf ( stderr, "\n" );
1610 for (i = 0; i < hdr->NumberOfSections; i++) {
1612 COFF_section* sectab_i
1614 myindex ( sizeof_COFF_section, sectab, i );
1621 printName ( sectab_i->Name, strtab );
1631 sectab_i->VirtualSize,
1632 sectab_i->VirtualAddress,
1633 sectab_i->SizeOfRawData,
1634 sectab_i->PointerToRawData,
1635 sectab_i->NumberOfRelocations,
1636 sectab_i->PointerToRelocations,
1637 sectab_i->PointerToRawData
1639 reltab = (COFF_reloc*) (
1640 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1643 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1644 /* If the relocation field (a short) has overflowed, the
1645 * real count can be found in the first reloc entry.
1647 * See Section 4.1 (last para) of the PE spec (rev6.0).
1649 COFF_reloc* rel = (COFF_reloc*)
1650 myindex ( sizeof_COFF_reloc, reltab, 0 );
1651 noRelocs = rel->VirtualAddress;
1654 noRelocs = sectab_i->NumberOfRelocations;
1658 for (; j < noRelocs; j++) {
1660 COFF_reloc* rel = (COFF_reloc*)
1661 myindex ( sizeof_COFF_reloc, reltab, j );
1663 " type 0x%-4x vaddr 0x%-8x name `",
1665 rel->VirtualAddress );
1666 sym = (COFF_symbol*)
1667 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1668 /* Hmm..mysterious looking offset - what's it for? SOF */
1669 printName ( sym->Name, strtab -10 );
1670 fprintf ( stderr, "'\n" );
1673 fprintf ( stderr, "\n" );
1675 fprintf ( stderr, "\n" );
1676 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1677 fprintf ( stderr, "---START of string table---\n");
1678 for (i = 4; i < *(Int32*)strtab; i++) {
1680 fprintf ( stderr, "\n"); else
1681 fprintf( stderr, "%c", strtab[i] );
1683 fprintf ( stderr, "--- END of string table---\n");
1685 fprintf ( stderr, "\n" );
1688 COFF_symbol* symtab_i;
1689 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1690 symtab_i = (COFF_symbol*)
1691 myindex ( sizeof_COFF_symbol, symtab, i );
1697 printName ( symtab_i->Name, strtab );
1706 (Int32)(symtab_i->SectionNumber),
1707 (UInt32)symtab_i->Type,
1708 (UInt32)symtab_i->StorageClass,
1709 (UInt32)symtab_i->NumberOfAuxSymbols
1711 i += symtab_i->NumberOfAuxSymbols;
1715 fprintf ( stderr, "\n" );
1721 ocGetNames_PEi386 ( ObjectCode* oc )
1724 COFF_section* sectab;
1725 COFF_symbol* symtab;
1732 hdr = (COFF_header*)(oc->image);
1733 sectab = (COFF_section*) (
1734 ((UChar*)(oc->image))
1735 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1737 symtab = (COFF_symbol*) (
1738 ((UChar*)(oc->image))
1739 + hdr->PointerToSymbolTable
1741 strtab = ((UChar*)(oc->image))
1742 + hdr->PointerToSymbolTable
1743 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1745 /* Allocate space for any (local, anonymous) .bss sections. */
1747 for (i = 0; i < hdr->NumberOfSections; i++) {
1749 COFF_section* sectab_i
1751 myindex ( sizeof_COFF_section, sectab, i );
1752 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1753 if (sectab_i->VirtualSize == 0) continue;
1754 /* This is a non-empty .bss section. Allocate zeroed space for
1755 it, and set its PointerToRawData field such that oc->image +
1756 PointerToRawData == addr_of_zeroed_space. */
1757 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1758 "ocGetNames_PEi386(anonymous bss)");
1759 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1760 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1761 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1764 /* Copy section information into the ObjectCode. */
1766 for (i = 0; i < hdr->NumberOfSections; i++) {
1772 = SECTIONKIND_OTHER;
1773 COFF_section* sectab_i
1775 myindex ( sizeof_COFF_section, sectab, i );
1776 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1779 /* I'm sure this is the Right Way to do it. However, the
1780 alternative of testing the sectab_i->Name field seems to
1781 work ok with Cygwin.
1783 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1784 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1785 kind = SECTIONKIND_CODE_OR_RODATA;
1788 if (0==strcmp(".text",sectab_i->Name) ||
1789 0==strcmp(".rodata",sectab_i->Name))
1790 kind = SECTIONKIND_CODE_OR_RODATA;
1791 if (0==strcmp(".data",sectab_i->Name) ||
1792 0==strcmp(".bss",sectab_i->Name))
1793 kind = SECTIONKIND_RWDATA;
1795 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1796 sz = sectab_i->SizeOfRawData;
1797 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1799 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1800 end = start + sz - 1;
1802 if (kind == SECTIONKIND_OTHER
1803 /* Ignore sections called which contain stabs debugging
1805 && 0 != strcmp(".stab", sectab_i->Name)
1806 && 0 != strcmp(".stabstr", sectab_i->Name)
1808 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1812 if (kind != SECTIONKIND_OTHER && end >= start) {
1813 addSection(oc, kind, start, end);
1814 addProddableBlock(oc, start, end - start + 1);
1818 /* Copy exported symbols into the ObjectCode. */
1820 oc->n_symbols = hdr->NumberOfSymbols;
1821 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1822 "ocGetNames_PEi386(oc->symbols)");
1823 /* Call me paranoid; I don't care. */
1824 for (i = 0; i < oc->n_symbols; i++)
1825 oc->symbols[i] = NULL;
1829 COFF_symbol* symtab_i;
1830 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1831 symtab_i = (COFF_symbol*)
1832 myindex ( sizeof_COFF_symbol, symtab, i );
1836 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1837 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1838 /* This symbol is global and defined, viz, exported */
1839 /* for MYIMAGE_SYMCLASS_EXTERNAL
1840 && !MYIMAGE_SYM_UNDEFINED,
1841 the address of the symbol is:
1842 address of relevant section + offset in section
1844 COFF_section* sectabent
1845 = (COFF_section*) myindex ( sizeof_COFF_section,
1847 symtab_i->SectionNumber-1 );
1848 addr = ((UChar*)(oc->image))
1849 + (sectabent->PointerToRawData
1853 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1854 && symtab_i->Value > 0) {
1855 /* This symbol isn't in any section at all, ie, global bss.
1856 Allocate zeroed space for it. */
1857 addr = stgCallocBytes(1, symtab_i->Value,
1858 "ocGetNames_PEi386(non-anonymous bss)");
1859 addSection(oc, SECTIONKIND_RWDATA, addr,
1860 ((UChar*)addr) + symtab_i->Value - 1);
1861 addProddableBlock(oc, addr, symtab_i->Value);
1862 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1865 if (addr != NULL ) {
1866 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1867 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1868 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1869 ASSERT(i >= 0 && i < oc->n_symbols);
1870 /* cstring_from_COFF_symbol_name always succeeds. */
1871 oc->symbols[i] = sname;
1872 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1876 "IGNORING symbol %d\n"
1880 printName ( symtab_i->Name, strtab );
1889 (Int32)(symtab_i->SectionNumber),
1890 (UInt32)symtab_i->Type,
1891 (UInt32)symtab_i->StorageClass,
1892 (UInt32)symtab_i->NumberOfAuxSymbols
1897 i += symtab_i->NumberOfAuxSymbols;
1906 ocResolve_PEi386 ( ObjectCode* oc )
1909 COFF_section* sectab;
1910 COFF_symbol* symtab;
1920 /* ToDo: should be variable-sized? But is at least safe in the
1921 sense of buffer-overrun-proof. */
1923 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1925 hdr = (COFF_header*)(oc->image);
1926 sectab = (COFF_section*) (
1927 ((UChar*)(oc->image))
1928 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1930 symtab = (COFF_symbol*) (
1931 ((UChar*)(oc->image))
1932 + hdr->PointerToSymbolTable
1934 strtab = ((UChar*)(oc->image))
1935 + hdr->PointerToSymbolTable
1936 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1938 for (i = 0; i < hdr->NumberOfSections; i++) {
1939 COFF_section* sectab_i
1941 myindex ( sizeof_COFF_section, sectab, i );
1944 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1947 /* Ignore sections called which contain stabs debugging
1949 if (0 == strcmp(".stab", sectab_i->Name)
1950 || 0 == strcmp(".stabstr", sectab_i->Name))
1953 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1954 /* If the relocation field (a short) has overflowed, the
1955 * real count can be found in the first reloc entry.
1957 * See Section 4.1 (last para) of the PE spec (rev6.0).
1959 * Nov2003 update: the GNU linker still doesn't correctly
1960 * handle the generation of relocatable object files with
1961 * overflown relocations. Hence the output to warn of potential
1964 COFF_reloc* rel = (COFF_reloc*)
1965 myindex ( sizeof_COFF_reloc, reltab, 0 );
1966 noRelocs = rel->VirtualAddress;
1967 fprintf(stderr, "WARNING: Overflown relocation field (# relocs found: %u)\n", noRelocs); fflush(stderr);
1970 noRelocs = sectab_i->NumberOfRelocations;
1975 for (; j < noRelocs; j++) {
1977 COFF_reloc* reltab_j
1979 myindex ( sizeof_COFF_reloc, reltab, j );
1981 /* the location to patch */
1983 ((UChar*)(oc->image))
1984 + (sectab_i->PointerToRawData
1985 + reltab_j->VirtualAddress
1986 - sectab_i->VirtualAddress )
1988 /* the existing contents of pP */
1990 /* the symbol to connect to */
1991 sym = (COFF_symbol*)
1992 myindex ( sizeof_COFF_symbol,
1993 symtab, reltab_j->SymbolTableIndex );
1996 "reloc sec %2d num %3d: type 0x%-4x "
1997 "vaddr 0x%-8x name `",
1999 (UInt32)reltab_j->Type,
2000 reltab_j->VirtualAddress );
2001 printName ( sym->Name, strtab );
2002 fprintf ( stderr, "'\n" ));
2004 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2005 COFF_section* section_sym
2006 = findPEi386SectionCalled ( oc, sym->Name );
2008 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
2011 S = ((UInt32)(oc->image))
2012 + (section_sym->PointerToRawData
2015 copyName ( sym->Name, strtab, symbol, 1000-1 );
2016 (void*)S = lookupLocalSymbol( oc, symbol );
2017 if ((void*)S != NULL) goto foundit;
2018 (void*)S = lookupSymbol( symbol );
2019 if ((void*)S != NULL) goto foundit;
2020 zapTrailingAtSign ( symbol );
2021 (void*)S = lookupLocalSymbol( oc, symbol );
2022 if ((void*)S != NULL) goto foundit;
2023 (void*)S = lookupSymbol( symbol );
2024 if ((void*)S != NULL) goto foundit;
2025 /* Newline first because the interactive linker has printed "linking..." */
2026 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2030 checkProddableBlock(oc, pP);
2031 switch (reltab_j->Type) {
2032 case MYIMAGE_REL_I386_DIR32:
2035 case MYIMAGE_REL_I386_REL32:
2036 /* Tricky. We have to insert a displacement at
2037 pP which, when added to the PC for the _next_
2038 insn, gives the address of the target (S).
2039 Problem is to know the address of the next insn
2040 when we only know pP. We assume that this
2041 literal field is always the last in the insn,
2042 so that the address of the next insn is pP+4
2043 -- hence the constant 4.
2044 Also I don't know if A should be added, but so
2045 far it has always been zero.
2048 *pP = S - ((UInt32)pP) - 4;
2051 belch("%s: unhandled PEi386 relocation type %d",
2052 oc->fileName, reltab_j->Type);
2059 IF_DEBUG(linker, belch("completed %s", oc->fileName));
2063 #endif /* defined(OBJFORMAT_PEi386) */
2066 /* --------------------------------------------------------------------------
2068 * ------------------------------------------------------------------------*/
2070 #if defined(OBJFORMAT_ELF)
2075 #if defined(sparc_TARGET_ARCH)
2076 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2077 #elif defined(i386_TARGET_ARCH)
2078 # define ELF_TARGET_386 /* Used inside <elf.h> */
2079 #elif defined(x86_64_TARGET_ARCH)
2080 # define ELF_TARGET_X64_64
2082 #elif defined (ia64_TARGET_ARCH)
2083 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2085 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2086 # define ELF_NEED_GOT /* needs Global Offset Table */
2087 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2090 #if !defined(openbsd_TARGET_OS)
2093 /* openbsd elf has things in different places, with diff names */
2094 #include <elf_abi.h>
2095 #include <machine/reloc.h>
2096 #define R_386_32 RELOC_32
2097 #define R_386_PC32 RELOC_PC32
2101 * Define a set of types which can be used for both ELF32 and ELF64
2105 #define ELFCLASS ELFCLASS64
2106 #define Elf_Addr Elf64_Addr
2107 #define Elf_Word Elf64_Word
2108 #define Elf_Sword Elf64_Sword
2109 #define Elf_Ehdr Elf64_Ehdr
2110 #define Elf_Phdr Elf64_Phdr
2111 #define Elf_Shdr Elf64_Shdr
2112 #define Elf_Sym Elf64_Sym
2113 #define Elf_Rel Elf64_Rel
2114 #define Elf_Rela Elf64_Rela
2115 #define ELF_ST_TYPE ELF64_ST_TYPE
2116 #define ELF_ST_BIND ELF64_ST_BIND
2117 #define ELF_R_TYPE ELF64_R_TYPE
2118 #define ELF_R_SYM ELF64_R_SYM
2120 #define ELFCLASS ELFCLASS32
2121 #define Elf_Addr Elf32_Addr
2122 #define Elf_Word Elf32_Word
2123 #define Elf_Sword Elf32_Sword
2124 #define Elf_Ehdr Elf32_Ehdr
2125 #define Elf_Phdr Elf32_Phdr
2126 #define Elf_Shdr Elf32_Shdr
2127 #define Elf_Sym Elf32_Sym
2128 #define Elf_Rel Elf32_Rel
2129 #define Elf_Rela Elf32_Rela
2131 #define ELF_ST_TYPE ELF32_ST_TYPE
2134 #define ELF_ST_BIND ELF32_ST_BIND
2137 #define ELF_R_TYPE ELF32_R_TYPE
2140 #define ELF_R_SYM ELF32_R_SYM
2146 * Functions to allocate entries in dynamic sections. Currently we simply
2147 * preallocate a large number, and we don't check if a entry for the given
2148 * target already exists (a linear search is too slow). Ideally these
2149 * entries would be associated with symbols.
2152 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2153 #define GOT_SIZE 0x20000
2154 #define FUNCTION_TABLE_SIZE 0x10000
2155 #define PLT_SIZE 0x08000
2158 static Elf_Addr got[GOT_SIZE];
2159 static unsigned int gotIndex;
2160 static Elf_Addr gp_val = (Elf_Addr)got;
2163 allocateGOTEntry(Elf_Addr target)
2167 if (gotIndex >= GOT_SIZE)
2168 barf("Global offset table overflow");
2170 entry = &got[gotIndex++];
2172 return (Elf_Addr)entry;
2176 #ifdef ELF_FUNCTION_DESC
2182 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2183 static unsigned int functionTableIndex;
2186 allocateFunctionDesc(Elf_Addr target)
2188 FunctionDesc *entry;
2190 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2191 barf("Function table overflow");
2193 entry = &functionTable[functionTableIndex++];
2195 entry->gp = (Elf_Addr)gp_val;
2196 return (Elf_Addr)entry;
2200 copyFunctionDesc(Elf_Addr target)
2202 FunctionDesc *olddesc = (FunctionDesc *)target;
2203 FunctionDesc *newdesc;
2205 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2206 newdesc->gp = olddesc->gp;
2207 return (Elf_Addr)newdesc;
2212 #ifdef ia64_TARGET_ARCH
2213 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2214 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2216 static unsigned char plt_code[] =
2218 /* taken from binutils bfd/elfxx-ia64.c */
2219 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2220 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2221 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2222 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2223 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2224 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2227 /* If we can't get to the function descriptor via gp, take a local copy of it */
2228 #define PLT_RELOC(code, target) { \
2229 Elf64_Sxword rel_value = target - gp_val; \
2230 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2231 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2233 ia64_reloc_gprel22((Elf_Addr)code, target); \
2238 unsigned char code[sizeof(plt_code)];
2242 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2244 PLTEntry *plt = (PLTEntry *)oc->plt;
2247 if (oc->pltIndex >= PLT_SIZE)
2248 barf("Procedure table overflow");
2250 entry = &plt[oc->pltIndex++];
2251 memcpy(entry->code, plt_code, sizeof(entry->code));
2252 PLT_RELOC(entry->code, target);
2253 return (Elf_Addr)entry;
2259 return (PLT_SIZE * sizeof(PLTEntry));
2265 * Generic ELF functions
2269 findElfSection ( void* objImage, Elf_Word sh_type )
2271 char* ehdrC = (char*)objImage;
2272 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2273 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2274 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2278 for (i = 0; i < ehdr->e_shnum; i++) {
2279 if (shdr[i].sh_type == sh_type
2280 /* Ignore the section header's string table. */
2281 && i != ehdr->e_shstrndx
2282 /* Ignore string tables named .stabstr, as they contain
2284 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2286 ptr = ehdrC + shdr[i].sh_offset;
2293 #if defined(ia64_TARGET_ARCH)
2295 findElfSegment ( void* objImage, Elf_Addr vaddr )
2297 char* ehdrC = (char*)objImage;
2298 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2299 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2300 Elf_Addr segaddr = 0;
2303 for (i = 0; i < ehdr->e_phnum; i++) {
2304 segaddr = phdr[i].p_vaddr;
2305 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2313 ocVerifyImage_ELF ( ObjectCode* oc )
2317 int i, j, nent, nstrtab, nsymtabs;
2321 char* ehdrC = (char*)(oc->image);
2322 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2324 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2325 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2326 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2327 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2328 belch("%s: not an ELF object", oc->fileName);
2332 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2333 belch("%s: unsupported ELF format", oc->fileName);
2337 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2338 IF_DEBUG(linker,belch( "Is little-endian" ));
2340 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2341 IF_DEBUG(linker,belch( "Is big-endian" ));
2343 belch("%s: unknown endiannness", oc->fileName);
2347 if (ehdr->e_type != ET_REL) {
2348 belch("%s: not a relocatable object (.o) file", oc->fileName);
2351 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2353 IF_DEBUG(linker,belch( "Architecture is " ));
2354 switch (ehdr->e_machine) {
2355 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2356 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2358 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2360 default: IF_DEBUG(linker,belch( "unknown" ));
2361 belch("%s: unknown architecture", oc->fileName);
2365 IF_DEBUG(linker,belch(
2366 "\nSection header table: start %d, n_entries %d, ent_size %d",
2367 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2369 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2371 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2373 if (ehdr->e_shstrndx == SHN_UNDEF) {
2374 belch("%s: no section header string table", oc->fileName);
2377 IF_DEBUG(linker,belch( "Section header string table is section %d",
2379 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2382 for (i = 0; i < ehdr->e_shnum; i++) {
2383 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2384 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2385 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2386 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2387 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2388 ehdrC + shdr[i].sh_offset,
2389 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2391 if (shdr[i].sh_type == SHT_REL) {
2392 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2393 } else if (shdr[i].sh_type == SHT_RELA) {
2394 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2396 IF_DEBUG(linker,fprintf(stderr," "));
2399 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2403 IF_DEBUG(linker,belch( "\nString tables" ));
2406 for (i = 0; i < ehdr->e_shnum; i++) {
2407 if (shdr[i].sh_type == SHT_STRTAB
2408 /* Ignore the section header's string table. */
2409 && i != ehdr->e_shstrndx
2410 /* Ignore string tables named .stabstr, as they contain
2412 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2414 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2415 strtab = ehdrC + shdr[i].sh_offset;
2420 belch("%s: no string tables, or too many", oc->fileName);
2425 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2426 for (i = 0; i < ehdr->e_shnum; i++) {
2427 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2428 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2430 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2431 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2432 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2434 shdr[i].sh_size % sizeof(Elf_Sym)
2436 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2437 belch("%s: non-integral number of symbol table entries", oc->fileName);
2440 for (j = 0; j < nent; j++) {
2441 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2442 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2443 (int)stab[j].st_shndx,
2444 (int)stab[j].st_size,
2445 (char*)stab[j].st_value ));
2447 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2448 switch (ELF_ST_TYPE(stab[j].st_info)) {
2449 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2450 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2451 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2452 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2453 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2454 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2456 IF_DEBUG(linker,fprintf(stderr, " " ));
2458 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2459 switch (ELF_ST_BIND(stab[j].st_info)) {
2460 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2461 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2462 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2463 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2465 IF_DEBUG(linker,fprintf(stderr, " " ));
2467 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2471 if (nsymtabs == 0) {
2472 belch("%s: didn't find any symbol tables", oc->fileName);
2481 ocGetNames_ELF ( ObjectCode* oc )
2486 char* ehdrC = (char*)(oc->image);
2487 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2488 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2489 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2491 ASSERT(symhash != NULL);
2494 belch("%s: no strtab", oc->fileName);
2499 for (i = 0; i < ehdr->e_shnum; i++) {
2500 /* Figure out what kind of section it is. Logic derived from
2501 Figure 1.14 ("Special Sections") of the ELF document
2502 ("Portable Formats Specification, Version 1.1"). */
2503 Elf_Shdr hdr = shdr[i];
2504 SectionKind kind = SECTIONKIND_OTHER;
2507 if (hdr.sh_type == SHT_PROGBITS
2508 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2509 /* .text-style section */
2510 kind = SECTIONKIND_CODE_OR_RODATA;
2513 if (hdr.sh_type == SHT_PROGBITS
2514 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2515 /* .data-style section */
2516 kind = SECTIONKIND_RWDATA;
2519 if (hdr.sh_type == SHT_PROGBITS
2520 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2521 /* .rodata-style section */
2522 kind = SECTIONKIND_CODE_OR_RODATA;
2525 if (hdr.sh_type == SHT_NOBITS
2526 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2527 /* .bss-style section */
2528 kind = SECTIONKIND_RWDATA;
2532 if (is_bss && shdr[i].sh_size > 0) {
2533 /* This is a non-empty .bss section. Allocate zeroed space for
2534 it, and set its .sh_offset field such that
2535 ehdrC + .sh_offset == addr_of_zeroed_space. */
2536 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2537 "ocGetNames_ELF(BSS)");
2538 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2540 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2541 zspace, shdr[i].sh_size);
2545 /* fill in the section info */
2546 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2547 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2548 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2549 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2552 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2554 /* copy stuff into this module's object symbol table */
2555 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2556 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2558 oc->n_symbols = nent;
2559 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2560 "ocGetNames_ELF(oc->symbols)");
2562 for (j = 0; j < nent; j++) {
2564 char isLocal = FALSE; /* avoids uninit-var warning */
2566 char* nm = strtab + stab[j].st_name;
2567 int secno = stab[j].st_shndx;
2569 /* Figure out if we want to add it; if so, set ad to its
2570 address. Otherwise leave ad == NULL. */
2572 if (secno == SHN_COMMON) {
2574 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2576 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2577 stab[j].st_size, nm);
2579 /* Pointless to do addProddableBlock() for this area,
2580 since the linker should never poke around in it. */
2583 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2584 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2586 /* and not an undefined symbol */
2587 && stab[j].st_shndx != SHN_UNDEF
2588 /* and not in a "special section" */
2589 && stab[j].st_shndx < SHN_LORESERVE
2591 /* and it's a not a section or string table or anything silly */
2592 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2593 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2594 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2597 /* Section 0 is the undefined section, hence > and not >=. */
2598 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2600 if (shdr[secno].sh_type == SHT_NOBITS) {
2601 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2602 stab[j].st_size, stab[j].st_value, nm);
2605 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2606 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2609 #ifdef ELF_FUNCTION_DESC
2610 /* dlsym() and the initialisation table both give us function
2611 * descriptors, so to be consistent we store function descriptors
2612 * in the symbol table */
2613 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2614 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2616 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2617 ad, oc->fileName, nm ));
2622 /* And the decision is ... */
2626 oc->symbols[j] = nm;
2629 /* Ignore entirely. */
2631 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2635 IF_DEBUG(linker,belch( "skipping `%s'",
2636 strtab + stab[j].st_name ));
2639 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2640 (int)ELF_ST_BIND(stab[j].st_info),
2641 (int)ELF_ST_TYPE(stab[j].st_info),
2642 (int)stab[j].st_shndx,
2643 strtab + stab[j].st_name
2646 oc->symbols[j] = NULL;
2655 /* Do ELF relocations which lack an explicit addend. All x86-linux
2656 relocations appear to be of this form. */
2658 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2659 Elf_Shdr* shdr, int shnum,
2660 Elf_Sym* stab, char* strtab )
2665 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2666 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2667 int target_shndx = shdr[shnum].sh_info;
2668 int symtab_shndx = shdr[shnum].sh_link;
2670 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2671 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2672 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2673 target_shndx, symtab_shndx ));
2675 for (j = 0; j < nent; j++) {
2676 Elf_Addr offset = rtab[j].r_offset;
2677 Elf_Addr info = rtab[j].r_info;
2679 Elf_Addr P = ((Elf_Addr)targ) + offset;
2680 Elf_Word* pP = (Elf_Word*)P;
2685 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2686 j, (void*)offset, (void*)info ));
2688 IF_DEBUG(linker,belch( " ZERO" ));
2691 Elf_Sym sym = stab[ELF_R_SYM(info)];
2692 /* First see if it is a local symbol. */
2693 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2694 /* Yes, so we can get the address directly from the ELF symbol
2696 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2698 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2699 + stab[ELF_R_SYM(info)].st_value);
2702 /* No, so look up the name in our global table. */
2703 symbol = strtab + sym.st_name;
2704 (void*)S = lookupSymbol( symbol );
2707 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2710 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2713 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2714 (void*)P, (void*)S, (void*)A ));
2715 checkProddableBlock ( oc, pP );
2719 switch (ELF_R_TYPE(info)) {
2720 # ifdef i386_TARGET_ARCH
2721 case R_386_32: *pP = value; break;
2722 case R_386_PC32: *pP = value - P; break;
2725 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2726 oc->fileName, ELF_R_TYPE(info));
2734 /* Do ELF relocations for which explicit addends are supplied.
2735 sparc-solaris relocations appear to be of this form. */
2737 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2738 Elf_Shdr* shdr, int shnum,
2739 Elf_Sym* stab, char* strtab )
2744 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2745 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2746 int target_shndx = shdr[shnum].sh_info;
2747 int symtab_shndx = shdr[shnum].sh_link;
2749 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2750 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2751 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2752 target_shndx, symtab_shndx ));
2754 for (j = 0; j < nent; j++) {
2755 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2756 /* This #ifdef only serves to avoid unused-var warnings. */
2757 Elf_Addr offset = rtab[j].r_offset;
2758 Elf_Addr P = targ + offset;
2760 Elf_Addr info = rtab[j].r_info;
2761 Elf_Addr A = rtab[j].r_addend;
2764 # if defined(sparc_TARGET_ARCH)
2765 Elf_Word* pP = (Elf_Word*)P;
2767 # elif defined(ia64_TARGET_ARCH)
2768 Elf64_Xword *pP = (Elf64_Xword *)P;
2772 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2773 j, (void*)offset, (void*)info,
2776 IF_DEBUG(linker,belch( " ZERO" ));
2779 Elf_Sym sym = stab[ELF_R_SYM(info)];
2780 /* First see if it is a local symbol. */
2781 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2782 /* Yes, so we can get the address directly from the ELF symbol
2784 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2786 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2787 + stab[ELF_R_SYM(info)].st_value);
2788 #ifdef ELF_FUNCTION_DESC
2789 /* Make a function descriptor for this function */
2790 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2791 S = allocateFunctionDesc(S + A);
2796 /* No, so look up the name in our global table. */
2797 symbol = strtab + sym.st_name;
2798 (void*)S = lookupSymbol( symbol );
2800 #ifdef ELF_FUNCTION_DESC
2801 /* If a function, already a function descriptor - we would
2802 have to copy it to add an offset. */
2803 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2804 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2808 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2811 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2814 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2815 (void*)P, (void*)S, (void*)A ));
2816 /* checkProddableBlock ( oc, (void*)P ); */
2820 switch (ELF_R_TYPE(info)) {
2821 # if defined(sparc_TARGET_ARCH)
2822 case R_SPARC_WDISP30:
2823 w1 = *pP & 0xC0000000;
2824 w2 = (Elf_Word)((value - P) >> 2);
2825 ASSERT((w2 & 0xC0000000) == 0);
2830 w1 = *pP & 0xFFC00000;
2831 w2 = (Elf_Word)(value >> 10);
2832 ASSERT((w2 & 0xFFC00000) == 0);
2838 w2 = (Elf_Word)(value & 0x3FF);
2839 ASSERT((w2 & ~0x3FF) == 0);
2843 /* According to the Sun documentation:
2845 This relocation type resembles R_SPARC_32, except it refers to an
2846 unaligned word. That is, the word to be relocated must be treated
2847 as four separate bytes with arbitrary alignment, not as a word
2848 aligned according to the architecture requirements.
2850 (JRS: which means that freeloading on the R_SPARC_32 case
2851 is probably wrong, but hey ...)
2855 w2 = (Elf_Word)value;
2858 # elif defined(ia64_TARGET_ARCH)
2859 case R_IA64_DIR64LSB:
2860 case R_IA64_FPTR64LSB:
2863 case R_IA64_PCREL64LSB:
2866 case R_IA64_SEGREL64LSB:
2867 addr = findElfSegment(ehdrC, value);
2870 case R_IA64_GPREL22:
2871 ia64_reloc_gprel22(P, value);
2873 case R_IA64_LTOFF22:
2874 case R_IA64_LTOFF22X:
2875 case R_IA64_LTOFF_FPTR22:
2876 addr = allocateGOTEntry(value);
2877 ia64_reloc_gprel22(P, addr);
2879 case R_IA64_PCREL21B:
2880 ia64_reloc_pcrel21(P, S, oc);
2883 /* This goes with R_IA64_LTOFF22X and points to the load to
2884 * convert into a move. We don't implement relaxation. */
2888 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2889 oc->fileName, ELF_R_TYPE(info));
2898 ocResolve_ELF ( ObjectCode* oc )
2902 Elf_Sym* stab = NULL;
2903 char* ehdrC = (char*)(oc->image);
2904 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2905 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2906 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2908 /* first find "the" symbol table */
2909 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2911 /* also go find the string table */
2912 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2914 if (stab == NULL || strtab == NULL) {
2915 belch("%s: can't find string or symbol table", oc->fileName);
2919 /* Process the relocation sections. */
2920 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2922 /* Skip sections called ".rel.stab". These appear to contain
2923 relocation entries that, when done, make the stabs debugging
2924 info point at the right places. We ain't interested in all
2926 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2929 if (shdr[shnum].sh_type == SHT_REL ) {
2930 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2931 shnum, stab, strtab );
2935 if (shdr[shnum].sh_type == SHT_RELA) {
2936 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2937 shnum, stab, strtab );
2942 /* Free the local symbol table; we won't need it again. */
2943 freeHashTable(oc->lochash, NULL);
2951 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2952 * at the front. The following utility functions pack and unpack instructions, and
2953 * take care of the most common relocations.
2956 #ifdef ia64_TARGET_ARCH
2959 ia64_extract_instruction(Elf64_Xword *target)
2962 int slot = (Elf_Addr)target & 3;
2963 (Elf_Addr)target &= ~3;
2971 return ((w1 >> 5) & 0x1ffffffffff);
2973 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2977 barf("ia64_extract_instruction: invalid slot %p", target);
2982 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2984 int slot = (Elf_Addr)target & 3;
2985 (Elf_Addr)target &= ~3;
2990 *target |= value << 5;
2993 *target |= value << 46;
2994 *(target+1) |= value >> 18;
2997 *(target+1) |= value << 23;
3003 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3005 Elf64_Xword instruction;
3006 Elf64_Sxword rel_value;
3008 rel_value = value - gp_val;
3009 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3010 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3012 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3013 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3014 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3015 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3016 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3017 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3021 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3023 Elf64_Xword instruction;
3024 Elf64_Sxword rel_value;
3027 entry = allocatePLTEntry(value, oc);
3029 rel_value = (entry >> 4) - (target >> 4);
3030 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3031 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3033 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3034 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3035 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3036 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3043 /* --------------------------------------------------------------------------
3045 * ------------------------------------------------------------------------*/
3047 #if defined(OBJFORMAT_MACHO)
3050 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3051 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3053 I hereby formally apologize for the hackish nature of this code.
3054 Things that need to be done:
3055 *) implement ocVerifyImage_MachO
3056 *) add still more sanity checks.
3061 ocAllocateJumpIslands_MachO
3063 Allocate additional space at the end of the object file image to make room
3066 PowerPC relative branch instructions have a 24 bit displacement field.
3067 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
3068 If a particular imported symbol is outside this range, we have to redirect
3069 the jump to a short piece of new code that just loads the 32bit absolute
3070 address and jumps there.
3071 This function just allocates space for one 16 byte jump island for every
3072 undefined symbol in the object file. The code for the islands is filled in by
3073 makeJumpIsland below.
3076 static const int islandSize = 16;
3078 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3080 char *image = (char*) oc->image;
3081 struct mach_header *header = (struct mach_header*) image;
3082 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3085 for(i=0;i<header->ncmds;i++)
3087 if(lc->cmd == LC_DYSYMTAB)
3089 struct dysymtab_command *dsymLC = (struct dysymtab_command*) lc;
3090 unsigned long nundefsym = dsymLC->nundefsym;
3091 oc->island_start_symbol = dsymLC->iundefsym;
3092 oc->n_islands = nundefsym;
3097 #error ocAllocateJumpIslands_MachO doesnt want USE_MMAP to be defined
3099 oc->image = stgReallocBytes(
3100 image, oc->fileSize + islandSize * nundefsym,
3101 "ocAllocateJumpIslands_MachO");
3103 oc->jump_islands = oc->image + oc->fileSize;
3104 memset(oc->jump_islands, 0, islandSize * nundefsym);
3107 break; // there can be only one LC_DSYMTAB
3109 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3114 static int ocVerifyImage_MachO(ObjectCode* oc)
3116 // FIXME: do some verifying here
3120 static int resolveImports(
3123 struct symtab_command *symLC,
3124 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3125 unsigned long *indirectSyms,
3126 struct nlist *nlist)
3130 for(i=0;i*4<sect->size;i++)
3132 // according to otool, reserved1 contains the first index into the indirect symbol table
3133 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3134 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3137 if((symbol->n_type & N_TYPE) == N_UNDF
3138 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3139 addr = (void*) (symbol->n_value);
3140 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3143 addr = lookupSymbol(nm);
3146 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3150 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3151 ((void**)(image + sect->offset))[i] = addr;
3157 static void* makeJumpIsland(
3159 unsigned long symbolNumber,
3162 if(symbolNumber < oc->island_start_symbol ||
3163 symbolNumber - oc->island_start_symbol > oc->n_islands)
3165 symbolNumber -= oc->island_start_symbol;
3167 void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber);
3168 unsigned long *p = (unsigned long*) island;
3170 // lis r12, hi16(target)
3171 *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 );
3172 // ori r12, r12, lo16(target)
3173 *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF );
3179 return (void*) island;
3182 static char* relocateAddress(
3185 struct section* sections,
3186 unsigned long address)
3189 for(i = 0; i < nSections; i++)
3191 if(sections[i].addr <= address
3192 && address < sections[i].addr + sections[i].size)
3194 return oc->image + sections[i].offset + address - sections[i].addr;
3197 barf("Invalid Mach-O file:"
3198 "Address out of bounds while relocating object file");
3202 static int relocateSection(
3205 struct symtab_command *symLC, struct nlist *nlist,
3206 int nSections, struct section* sections, struct section *sect)
3208 struct relocation_info *relocs;
3211 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3213 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3217 relocs = (struct relocation_info*) (image + sect->reloff);
3221 if(relocs[i].r_address & R_SCATTERED)
3223 struct scattered_relocation_info *scat =
3224 (struct scattered_relocation_info*) &relocs[i];
3228 if(scat->r_length == 2)
3230 unsigned long word = 0;
3231 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3232 checkProddableBlock(oc,wordPtr);
3234 // Step 1: Figure out what the relocated value should be
3235 if(scat->r_type == GENERIC_RELOC_VANILLA)
3237 word = scat->r_value + sect->offset + ((long) image);
3239 else if(scat->r_type == PPC_RELOC_SECTDIFF
3240 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3241 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3242 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3244 struct scattered_relocation_info *pair =
3245 (struct scattered_relocation_info*) &relocs[i+1];
3247 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3248 barf("Invalid Mach-O file: "
3249 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3251 word = (unsigned long)
3252 (relocateAddress(oc, nSections, sections, scat->r_value)
3253 - relocateAddress(oc, nSections, sections, pair->r_value));
3256 else if(scat->r_type == PPC_RELOC_HI16
3257 || scat->r_type == PPC_RELOC_LO16
3258 || scat->r_type == PPC_RELOC_HA16
3259 || scat->r_type == PPC_RELOC_LO14)
3260 { // these are generated by label+offset things
3261 struct relocation_info *pair = &relocs[i+1];
3262 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3263 barf("Invalid Mach-O file: "
3264 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3266 if(scat->r_type == PPC_RELOC_LO16)
3268 word = ((unsigned short*) wordPtr)[1];
3269 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3271 else if(scat->r_type == PPC_RELOC_LO14)
3273 barf("Unsupported Relocation: PPC_RELOC_LO14");
3274 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3275 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3277 else if(scat->r_type == PPC_RELOC_HI16)
3279 word = ((unsigned short*) wordPtr)[1] << 16;
3280 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3282 else if(scat->r_type == PPC_RELOC_HA16)
3284 word = ((unsigned short*) wordPtr)[1] << 16;
3285 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3289 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3295 continue; // ignore the others
3297 if(scat->r_type == GENERIC_RELOC_VANILLA
3298 || scat->r_type == PPC_RELOC_SECTDIFF)
3302 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3304 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3306 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3308 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3310 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3312 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3313 + ((word & (1<<15)) ? 1 : 0);
3318 continue; // FIXME: I hope it's OK to ignore all the others.
3322 struct relocation_info *reloc = &relocs[i];
3323 if(reloc->r_pcrel && !reloc->r_extern)
3326 if(reloc->r_length == 2)
3328 unsigned long word = 0;
3329 unsigned long jumpIsland = 0;
3330 long offsetToJumpIsland;
3332 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3333 checkProddableBlock(oc,wordPtr);
3335 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3339 else if(reloc->r_type == PPC_RELOC_LO16)
3341 word = ((unsigned short*) wordPtr)[1];
3342 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3344 else if(reloc->r_type == PPC_RELOC_HI16)
3346 word = ((unsigned short*) wordPtr)[1] << 16;
3347 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3349 else if(reloc->r_type == PPC_RELOC_HA16)
3351 word = ((unsigned short*) wordPtr)[1] << 16;
3352 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3354 else if(reloc->r_type == PPC_RELOC_BR24)
3357 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3361 if(!reloc->r_extern)
3364 sections[reloc->r_symbolnum-1].offset
3365 - sections[reloc->r_symbolnum-1].addr
3372 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3373 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3374 unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
3377 belch("\nunknown symbol `%s'", nm);
3384 word = symbolAddress;
3385 jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
3386 word -= ((long)image) + sect->offset + reloc->r_address;
3389 offsetToJumpIsland = jumpIsland
3390 - (((long)image) + sect->offset + reloc->r_address);
3395 word += symbolAddress;
3399 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3404 else if(reloc->r_type == PPC_RELOC_LO16)
3406 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3409 else if(reloc->r_type == PPC_RELOC_HI16)
3411 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3414 else if(reloc->r_type == PPC_RELOC_HA16)
3416 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3417 + ((word & (1<<15)) ? 1 : 0);
3420 else if(reloc->r_type == PPC_RELOC_BR24)
3422 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3424 // The branch offset is too large.
3425 // Therefore, we try to use a jump island.
3427 barf("unconditional relative branch out of range: "
3428 "no jump island available");
3430 word = offsetToJumpIsland;
3431 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3432 barf("unconditional relative branch out of range: "
3433 "jump island out of range");
3435 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3439 barf("\nunknown relocation %d",reloc->r_type);
3446 static int ocGetNames_MachO(ObjectCode* oc)
3448 char *image = (char*) oc->image;
3449 struct mach_header *header = (struct mach_header*) image;
3450 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3451 unsigned i,curSymbol;
3452 struct segment_command *segLC = NULL;
3453 struct section *sections;
3454 struct symtab_command *symLC = NULL;
3455 struct dysymtab_command *dsymLC = NULL;
3456 struct nlist *nlist;
3457 unsigned long commonSize = 0;
3458 char *commonStorage = NULL;
3459 unsigned long commonCounter;
3461 for(i=0;i<header->ncmds;i++)
3463 if(lc->cmd == LC_SEGMENT)
3464 segLC = (struct segment_command*) lc;
3465 else if(lc->cmd == LC_SYMTAB)
3466 symLC = (struct symtab_command*) lc;
3467 else if(lc->cmd == LC_DYSYMTAB)
3468 dsymLC = (struct dysymtab_command*) lc;
3469 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3472 sections = (struct section*) (segLC+1);
3473 nlist = (struct nlist*) (image + symLC->symoff);
3475 for(i=0;i<segLC->nsects;i++)
3477 if(sections[i].size == 0)
3480 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3482 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3483 "ocGetNames_MachO(common symbols)");
3484 sections[i].offset = zeroFillArea - image;
3487 if(!strcmp(sections[i].sectname,"__text"))
3488 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3489 (void*) (image + sections[i].offset),
3490 (void*) (image + sections[i].offset + sections[i].size));
3491 else if(!strcmp(sections[i].sectname,"__const"))
3492 addSection(oc, SECTIONKIND_RWDATA,
3493 (void*) (image + sections[i].offset),
3494 (void*) (image + sections[i].offset + sections[i].size));
3495 else if(!strcmp(sections[i].sectname,"__data"))
3496 addSection(oc, SECTIONKIND_RWDATA,
3497 (void*) (image + sections[i].offset),
3498 (void*) (image + sections[i].offset + sections[i].size));
3499 else if(!strcmp(sections[i].sectname,"__bss")
3500 || !strcmp(sections[i].sectname,"__common"))
3501 addSection(oc, SECTIONKIND_RWDATA,
3502 (void*) (image + sections[i].offset),
3503 (void*) (image + sections[i].offset + sections[i].size));
3505 addProddableBlock(oc, (void*) (image + sections[i].offset),
3509 // count external symbols defined here
3511 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3513 if((nlist[i].n_type & N_TYPE) == N_SECT)
3516 for(i=0;i<symLC->nsyms;i++)
3518 if((nlist[i].n_type & N_TYPE) == N_UNDF
3519 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3521 commonSize += nlist[i].n_value;
3525 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3526 "ocGetNames_MachO(oc->symbols)");
3528 // insert symbols into hash table
3529 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3531 if((nlist[i].n_type & N_TYPE) == N_SECT)
3533 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3534 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3535 sections[nlist[i].n_sect-1].offset
3536 - sections[nlist[i].n_sect-1].addr
3537 + nlist[i].n_value);
3538 oc->symbols[curSymbol++] = nm;
3542 // insert local symbols into lochash
3543 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3545 if((nlist[i].n_type & N_TYPE) == N_SECT)
3547 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3548 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3549 sections[nlist[i].n_sect-1].offset
3550 - sections[nlist[i].n_sect-1].addr
3551 + nlist[i].n_value);
3556 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3557 commonCounter = (unsigned long)commonStorage;
3558 for(i=0;i<symLC->nsyms;i++)
3560 if((nlist[i].n_type & N_TYPE) == N_UNDF
3561 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3563 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3564 unsigned long sz = nlist[i].n_value;
3566 nlist[i].n_value = commonCounter;
3568 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3569 oc->symbols[curSymbol++] = nm;
3571 commonCounter += sz;
3577 static int ocResolve_MachO(ObjectCode* oc)
3579 char *image = (char*) oc->image;
3580 struct mach_header *header = (struct mach_header*) image;
3581 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3583 struct segment_command *segLC = NULL;
3584 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3585 struct symtab_command *symLC = NULL;
3586 struct dysymtab_command *dsymLC = NULL;
3587 struct nlist *nlist;
3588 unsigned long *indirectSyms;
3590 for(i=0;i<header->ncmds;i++)
3592 if(lc->cmd == LC_SEGMENT)
3593 segLC = (struct segment_command*) lc;
3594 else if(lc->cmd == LC_SYMTAB)
3595 symLC = (struct symtab_command*) lc;
3596 else if(lc->cmd == LC_DYSYMTAB)
3597 dsymLC = (struct dysymtab_command*) lc;
3598 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3601 sections = (struct section*) (segLC+1);
3602 nlist = (struct nlist*) (image + symLC->symoff);
3604 for(i=0;i<segLC->nsects;i++)
3606 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3607 la_ptrs = §ions[i];
3608 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3609 nl_ptrs = §ions[i];
3612 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3615 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3618 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3621 for(i=0;i<segLC->nsects;i++)
3623 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3627 /* Free the local symbol table; we won't need it again. */
3628 freeHashTable(oc->lochash, NULL);
3632 Flush the data & instruction caches.
3633 Because the PPC has split data/instruction caches, we have to
3634 do that whenever we modify code at runtime.
3637 int n = (oc->fileSize + islandSize * oc->n_islands) / 4;
3638 unsigned long *p = (unsigned long*)oc->image;
3641 __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
3645 __asm__ volatile ("sync\n\tisync");
3651 * The Mach-O object format uses leading underscores. But not everywhere.
3652 * There is a small number of runtime support functions defined in
3653 * libcc_dynamic.a whose name does not have a leading underscore.
3654 * As a consequence, we can't get their address from C code.
3655 * We have to use inline assembler just to take the address of a function.
3659 static void machoInitSymbolsWithoutUnderscore()
3665 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3666 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3668 RTS_MACHO_NOUNDERLINE_SYMBOLS