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_0_info) \
519 SymX(stg_ap_v_info) \
520 SymX(stg_ap_f_info) \
521 SymX(stg_ap_d_info) \
522 SymX(stg_ap_l_info) \
523 SymX(stg_ap_n_info) \
524 SymX(stg_ap_p_info) \
525 SymX(stg_ap_pv_info) \
526 SymX(stg_ap_pp_info) \
527 SymX(stg_ap_ppv_info) \
528 SymX(stg_ap_ppp_info) \
529 SymX(stg_ap_pppv_info) \
530 SymX(stg_ap_pppp_info) \
531 SymX(stg_ap_ppppp_info) \
532 SymX(stg_ap_pppppp_info) \
533 SymX(stg_ap_1_upd_info) \
534 SymX(stg_ap_2_upd_info) \
535 SymX(stg_ap_3_upd_info) \
536 SymX(stg_ap_4_upd_info) \
537 SymX(stg_ap_5_upd_info) \
538 SymX(stg_ap_6_upd_info) \
539 SymX(stg_ap_7_upd_info) \
541 SymX(stg_sel_0_upd_info) \
542 SymX(stg_sel_10_upd_info) \
543 SymX(stg_sel_11_upd_info) \
544 SymX(stg_sel_12_upd_info) \
545 SymX(stg_sel_13_upd_info) \
546 SymX(stg_sel_14_upd_info) \
547 SymX(stg_sel_15_upd_info) \
548 SymX(stg_sel_1_upd_info) \
549 SymX(stg_sel_2_upd_info) \
550 SymX(stg_sel_3_upd_info) \
551 SymX(stg_sel_4_upd_info) \
552 SymX(stg_sel_5_upd_info) \
553 SymX(stg_sel_6_upd_info) \
554 SymX(stg_sel_7_upd_info) \
555 SymX(stg_sel_8_upd_info) \
556 SymX(stg_sel_9_upd_info) \
557 SymX(stg_upd_frame_info) \
558 SymX(suspendThread) \
559 SymX(takeMVarzh_fast) \
560 SymX(timesIntegerzh_fast) \
561 SymX(tryPutMVarzh_fast) \
562 SymX(tryTakeMVarzh_fast) \
563 SymX(unblockAsyncExceptionszh_fast) \
565 SymX(unsafeThawArrayzh_fast) \
566 SymX(waitReadzh_fast) \
567 SymX(waitWritezh_fast) \
568 SymX(word2Integerzh_fast) \
569 SymX(xorIntegerzh_fast) \
572 #ifdef SUPPORT_LONG_LONGS
573 #define RTS_LONG_LONG_SYMS \
574 SymX(int64ToIntegerzh_fast) \
575 SymX(word64ToIntegerzh_fast)
577 #define RTS_LONG_LONG_SYMS /* nothing */
580 // 64-bit support functions in libgcc.a
581 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
582 #define RTS_LIBGCC_SYMBOLS \
591 #elif defined(ia64_TARGET_ARCH)
592 #define RTS_LIBGCC_SYMBOLS \
600 #define RTS_LIBGCC_SYMBOLS
603 #ifdef darwin_TARGET_OS
604 // Symbols that don't have a leading underscore
605 // on Mac OS X. They have to receive special treatment,
606 // see machoInitSymbolsWithoutUnderscore()
607 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
612 /* entirely bogus claims about types of these symbols */
613 #define Sym(vvv) extern void vvv(void);
614 #define SymX(vvv) /**/
615 #define SymX_redirect(vvv,xxx) /**/
619 RTS_POSIX_ONLY_SYMBOLS
620 RTS_MINGW_ONLY_SYMBOLS
621 RTS_CYGWIN_ONLY_SYMBOLS
627 #ifdef LEADING_UNDERSCORE
628 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
630 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
633 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
635 #define SymX(vvv) Sym(vvv)
637 // SymX_redirect allows us to redirect references to one symbol to
638 // another symbol. See newCAF/newDynCAF for an example.
639 #define SymX_redirect(vvv,xxx) \
640 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
643 static RtsSymbolVal rtsSyms[] = {
647 RTS_POSIX_ONLY_SYMBOLS
648 RTS_MINGW_ONLY_SYMBOLS
649 RTS_CYGWIN_ONLY_SYMBOLS
651 { 0, 0 } /* sentinel */
654 /* -----------------------------------------------------------------------------
655 * Insert symbols into hash tables, checking for duplicates.
657 static void ghciInsertStrHashTable ( char* obj_name,
663 if (lookupHashTable(table, (StgWord)key) == NULL)
665 insertStrHashTable(table, (StgWord)key, data);
670 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
672 "whilst processing object file\n"
674 "This could be caused by:\n"
675 " * Loading two different object files which export the same symbol\n"
676 " * Specifying the same object file twice on the GHCi command line\n"
677 " * An incorrect `package.conf' entry, causing some object to be\n"
679 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
688 /* -----------------------------------------------------------------------------
689 * initialize the object linker
693 static int linker_init_done = 0 ;
695 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
696 static void *dl_prog_handle;
699 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
700 #if defined(openbsd_TARGET_OS)
701 static void *dl_libc_handle;
709 /* Make initLinker idempotent, so we can call it
710 before evey relevant operation; that means we
711 don't need to initialise the linker separately */
712 if (linker_init_done == 1) { return; } else {
713 linker_init_done = 1;
716 symhash = allocStrHashTable();
718 /* populate the symbol table with stuff from the RTS */
719 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
720 ghciInsertStrHashTable("(GHCi built-in symbols)",
721 symhash, sym->lbl, sym->addr);
723 # if defined(OBJFORMAT_MACHO)
724 machoInitSymbolsWithoutUnderscore();
727 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
728 # if defined(RTLD_DEFAULT)
729 dl_prog_handle = RTLD_DEFAULT;
731 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
732 # if defined(openbsd_TARGET_OS)
733 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
735 # endif // RTLD_DEFAULT
739 /* -----------------------------------------------------------------------------
740 * Loading DLL or .so dynamic libraries
741 * -----------------------------------------------------------------------------
743 * Add a DLL from which symbols may be found. In the ELF case, just
744 * do RTLD_GLOBAL-style add, so no further messing around needs to
745 * happen in order that symbols in the loaded .so are findable --
746 * lookupSymbol() will subsequently see them by dlsym on the program's
747 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
749 * In the PEi386 case, open the DLLs and put handles to them in a
750 * linked list. When looking for a symbol, try all handles in the
751 * list. This means that we need to load even DLLs that are guaranteed
752 * to be in the ghc.exe image already, just so we can get a handle
753 * to give to loadSymbol, so that we can find the symbols. For such
754 * libraries, the LoadLibrary call should be a no-op except for returning
759 #if defined(OBJFORMAT_PEi386)
760 /* A record for storing handles into DLLs. */
765 struct _OpenedDLL* next;
770 /* A list thereof. */
771 static OpenedDLL* opened_dlls = NULL;
775 addDLL( char *dll_name )
777 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
778 /* ------------------- ELF DLL loader ------------------- */
784 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
787 /* dlopen failed; return a ptr to the error msg. */
789 if (errmsg == NULL) errmsg = "addDLL: unknown error";
796 # elif defined(OBJFORMAT_PEi386)
797 /* ------------------- Win32 DLL loader ------------------- */
805 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
807 /* See if we've already got it, and ignore if so. */
808 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
809 if (0 == strcmp(o_dll->name, dll_name))
813 /* The file name has no suffix (yet) so that we can try
814 both foo.dll and foo.drv
816 The documentation for LoadLibrary says:
817 If no file name extension is specified in the lpFileName
818 parameter, the default library extension .dll is
819 appended. However, the file name string can include a trailing
820 point character (.) to indicate that the module name has no
823 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
824 sprintf(buf, "%s.DLL", dll_name);
825 instance = LoadLibrary(buf);
826 if (instance == NULL) {
827 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
828 instance = LoadLibrary(buf);
829 if (instance == NULL) {
832 /* LoadLibrary failed; return a ptr to the error msg. */
833 return "addDLL: unknown error";
838 /* Add this DLL to the list of DLLs in which to search for symbols. */
839 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
840 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
841 strcpy(o_dll->name, dll_name);
842 o_dll->instance = instance;
843 o_dll->next = opened_dlls;
848 barf("addDLL: not implemented on this platform");
852 /* -----------------------------------------------------------------------------
853 * lookup a symbol in the hash table
856 lookupSymbol( char *lbl )
860 ASSERT(symhash != NULL);
861 val = lookupStrHashTable(symhash, lbl);
864 # if defined(OBJFORMAT_ELF)
865 # if defined(openbsd_TARGET_OS)
866 val = dlsym(dl_prog_handle, lbl);
867 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
868 # else /* not openbsd */
869 return dlsym(dl_prog_handle, lbl);
871 # elif defined(OBJFORMAT_MACHO)
872 if(NSIsSymbolNameDefined(lbl)) {
873 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
874 return NSAddressOfSymbol(symbol);
878 # elif defined(OBJFORMAT_PEi386)
881 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
882 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
884 /* HACK: if the name has an initial underscore, try stripping
885 it off & look that up first. I've yet to verify whether there's
886 a Rule that governs whether an initial '_' *should always* be
887 stripped off when mapping from import lib name to the DLL name.
889 sym = GetProcAddress(o_dll->instance, (lbl+1));
891 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
895 sym = GetProcAddress(o_dll->instance, lbl);
897 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
912 __attribute((unused))
914 lookupLocalSymbol( ObjectCode* oc, char *lbl )
918 val = lookupStrHashTable(oc->lochash, lbl);
928 /* -----------------------------------------------------------------------------
929 * Debugging aid: look in GHCi's object symbol tables for symbols
930 * within DELTA bytes of the specified address, and show their names.
933 void ghci_enquire ( char* addr );
935 void ghci_enquire ( char* addr )
940 const int DELTA = 64;
945 for (oc = objects; oc; oc = oc->next) {
946 for (i = 0; i < oc->n_symbols; i++) {
947 sym = oc->symbols[i];
948 if (sym == NULL) continue;
949 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
951 if (oc->lochash != NULL) {
952 a = lookupStrHashTable(oc->lochash, sym);
955 a = lookupStrHashTable(symhash, sym);
958 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
960 else if (addr-DELTA <= a && a <= addr+DELTA) {
961 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
968 #ifdef ia64_TARGET_ARCH
969 static unsigned int PLTSize(void);
972 /* -----------------------------------------------------------------------------
973 * Load an obj (populate the global symbol table, but don't resolve yet)
975 * Returns: 1 if ok, 0 on error.
978 loadObj( char *path )
985 void *map_addr = NULL;
992 /* fprintf(stderr, "loadObj %s\n", path ); */
994 /* Check that we haven't already loaded this object.
995 Ignore requests to load multiple times */
999 for (o = objects; o; o = o->next) {
1000 if (0 == strcmp(o->fileName, path)) {
1002 break; /* don't need to search further */
1006 IF_DEBUG(linker, belch(
1007 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1008 "same object file twice:\n"
1010 "GHCi will ignore this, but be warned.\n"
1012 return 1; /* success */
1016 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1018 # if defined(OBJFORMAT_ELF)
1019 oc->formatName = "ELF";
1020 # elif defined(OBJFORMAT_PEi386)
1021 oc->formatName = "PEi386";
1022 # elif defined(OBJFORMAT_MACHO)
1023 oc->formatName = "Mach-O";
1026 barf("loadObj: not implemented on this platform");
1029 r = stat(path, &st);
1030 if (r == -1) { return 0; }
1032 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1033 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1034 strcpy(oc->fileName, path);
1036 oc->fileSize = st.st_size;
1038 oc->sections = NULL;
1039 oc->lochash = allocStrHashTable();
1040 oc->proddables = NULL;
1042 /* chain it onto the list of objects */
1047 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1049 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1051 #if defined(openbsd_TARGET_OS)
1052 fd = open(path, O_RDONLY, S_IRUSR);
1054 fd = open(path, O_RDONLY);
1057 barf("loadObj: can't open `%s'", path);
1059 pagesize = getpagesize();
1061 #ifdef ia64_TARGET_ARCH
1062 /* The PLT needs to be right before the object */
1063 n = ROUND_UP(PLTSize(), pagesize);
1064 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1065 if (oc->plt == MAP_FAILED)
1066 barf("loadObj: can't allocate PLT");
1069 map_addr = oc->plt + n;
1072 n = ROUND_UP(oc->fileSize, pagesize);
1073 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1074 if (oc->image == MAP_FAILED)
1075 barf("loadObj: can't map `%s'", path);
1079 #else /* !USE_MMAP */
1081 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1083 /* load the image into memory */
1084 f = fopen(path, "rb");
1086 barf("loadObj: can't read `%s'", path);
1088 n = fread ( oc->image, 1, oc->fileSize, f );
1089 if (n != oc->fileSize)
1090 barf("loadObj: error whilst reading `%s'", path);
1094 #endif /* USE_MMAP */
1096 # if defined(OBJFORMAT_MACHO)
1097 r = ocAllocateJumpIslands_MachO ( oc );
1098 if (!r) { return r; }
1101 /* verify the in-memory image */
1102 # if defined(OBJFORMAT_ELF)
1103 r = ocVerifyImage_ELF ( oc );
1104 # elif defined(OBJFORMAT_PEi386)
1105 r = ocVerifyImage_PEi386 ( oc );
1106 # elif defined(OBJFORMAT_MACHO)
1107 r = ocVerifyImage_MachO ( oc );
1109 barf("loadObj: no verify method");
1111 if (!r) { return r; }
1113 /* build the symbol list for this image */
1114 # if defined(OBJFORMAT_ELF)
1115 r = ocGetNames_ELF ( oc );
1116 # elif defined(OBJFORMAT_PEi386)
1117 r = ocGetNames_PEi386 ( oc );
1118 # elif defined(OBJFORMAT_MACHO)
1119 r = ocGetNames_MachO ( oc );
1121 barf("loadObj: no getNames method");
1123 if (!r) { return r; }
1125 /* loaded, but not resolved yet */
1126 oc->status = OBJECT_LOADED;
1131 /* -----------------------------------------------------------------------------
1132 * resolve all the currently unlinked objects in memory
1134 * Returns: 1 if ok, 0 on error.
1144 for (oc = objects; oc; oc = oc->next) {
1145 if (oc->status != OBJECT_RESOLVED) {
1146 # if defined(OBJFORMAT_ELF)
1147 r = ocResolve_ELF ( oc );
1148 # elif defined(OBJFORMAT_PEi386)
1149 r = ocResolve_PEi386 ( oc );
1150 # elif defined(OBJFORMAT_MACHO)
1151 r = ocResolve_MachO ( oc );
1153 barf("resolveObjs: not implemented on this platform");
1155 if (!r) { return r; }
1156 oc->status = OBJECT_RESOLVED;
1162 /* -----------------------------------------------------------------------------
1163 * delete an object from the pool
1166 unloadObj( char *path )
1168 ObjectCode *oc, *prev;
1170 ASSERT(symhash != NULL);
1171 ASSERT(objects != NULL);
1176 for (oc = objects; oc; prev = oc, oc = oc->next) {
1177 if (!strcmp(oc->fileName,path)) {
1179 /* Remove all the mappings for the symbols within this
1184 for (i = 0; i < oc->n_symbols; i++) {
1185 if (oc->symbols[i] != NULL) {
1186 removeStrHashTable(symhash, oc->symbols[i], NULL);
1194 prev->next = oc->next;
1197 /* We're going to leave this in place, in case there are
1198 any pointers from the heap into it: */
1199 /* stgFree(oc->image); */
1200 stgFree(oc->fileName);
1201 stgFree(oc->symbols);
1202 stgFree(oc->sections);
1203 /* The local hash table should have been freed at the end
1204 of the ocResolve_ call on it. */
1205 ASSERT(oc->lochash == NULL);
1211 belch("unloadObj: can't find `%s' to unload", path);
1215 /* -----------------------------------------------------------------------------
1216 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1217 * which may be prodded during relocation, and abort if we try and write
1218 * outside any of these.
1220 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1223 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1224 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1228 pb->next = oc->proddables;
1229 oc->proddables = pb;
1232 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1235 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1236 char* s = (char*)(pb->start);
1237 char* e = s + pb->size - 1;
1238 char* a = (char*)addr;
1239 /* Assumes that the biggest fixup involves a 4-byte write. This
1240 probably needs to be changed to 8 (ie, +7) on 64-bit
1242 if (a >= s && (a+3) <= e) return;
1244 barf("checkProddableBlock: invalid fixup in runtime linker");
1247 /* -----------------------------------------------------------------------------
1248 * Section management.
1250 static void addSection ( ObjectCode* oc, SectionKind kind,
1251 void* start, void* end )
1253 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1257 s->next = oc->sections;
1260 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1261 start, ((char*)end)-1, end - start + 1, kind );
1267 /* --------------------------------------------------------------------------
1268 * PEi386 specifics (Win32 targets)
1269 * ------------------------------------------------------------------------*/
1271 /* The information for this linker comes from
1272 Microsoft Portable Executable
1273 and Common Object File Format Specification
1274 revision 5.1 January 1998
1275 which SimonM says comes from the MS Developer Network CDs.
1277 It can be found there (on older CDs), but can also be found
1280 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1282 (this is Rev 6.0 from February 1999).
1284 Things move, so if that fails, try searching for it via
1286 http://www.google.com/search?q=PE+COFF+specification
1288 The ultimate reference for the PE format is the Winnt.h
1289 header file that comes with the Platform SDKs; as always,
1290 implementations will drift wrt their documentation.
1292 A good background article on the PE format is Matt Pietrek's
1293 March 1994 article in Microsoft System Journal (MSJ)
1294 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1295 Win32 Portable Executable File Format." The info in there
1296 has recently been updated in a two part article in
1297 MSDN magazine, issues Feb and March 2002,
1298 "Inside Windows: An In-Depth Look into the Win32 Portable
1299 Executable File Format"
1301 John Levine's book "Linkers and Loaders" contains useful
1306 #if defined(OBJFORMAT_PEi386)
1310 typedef unsigned char UChar;
1311 typedef unsigned short UInt16;
1312 typedef unsigned int UInt32;
1319 UInt16 NumberOfSections;
1320 UInt32 TimeDateStamp;
1321 UInt32 PointerToSymbolTable;
1322 UInt32 NumberOfSymbols;
1323 UInt16 SizeOfOptionalHeader;
1324 UInt16 Characteristics;
1328 #define sizeof_COFF_header 20
1335 UInt32 VirtualAddress;
1336 UInt32 SizeOfRawData;
1337 UInt32 PointerToRawData;
1338 UInt32 PointerToRelocations;
1339 UInt32 PointerToLinenumbers;
1340 UInt16 NumberOfRelocations;
1341 UInt16 NumberOfLineNumbers;
1342 UInt32 Characteristics;
1346 #define sizeof_COFF_section 40
1353 UInt16 SectionNumber;
1356 UChar NumberOfAuxSymbols;
1360 #define sizeof_COFF_symbol 18
1365 UInt32 VirtualAddress;
1366 UInt32 SymbolTableIndex;
1371 #define sizeof_COFF_reloc 10
1374 /* From PE spec doc, section 3.3.2 */
1375 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1376 windows.h -- for the same purpose, but I want to know what I'm
1378 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1379 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1380 #define MYIMAGE_FILE_DLL 0x2000
1381 #define MYIMAGE_FILE_SYSTEM 0x1000
1382 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1383 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1384 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1386 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1387 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1388 #define MYIMAGE_SYM_CLASS_STATIC 3
1389 #define MYIMAGE_SYM_UNDEFINED 0
1391 /* From PE spec doc, section 4.1 */
1392 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1393 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1394 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1396 /* From PE spec doc, section 5.2.1 */
1397 #define MYIMAGE_REL_I386_DIR32 0x0006
1398 #define MYIMAGE_REL_I386_REL32 0x0014
1401 /* We use myindex to calculate array addresses, rather than
1402 simply doing the normal subscript thing. That's because
1403 some of the above structs have sizes which are not
1404 a whole number of words. GCC rounds their sizes up to a
1405 whole number of words, which means that the address calcs
1406 arising from using normal C indexing or pointer arithmetic
1407 are just plain wrong. Sigh.
1410 myindex ( int scale, void* base, int index )
1413 ((UChar*)base) + scale * index;
1418 printName ( UChar* name, UChar* strtab )
1420 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1421 UInt32 strtab_offset = * (UInt32*)(name+4);
1422 fprintf ( stderr, "%s", strtab + strtab_offset );
1425 for (i = 0; i < 8; i++) {
1426 if (name[i] == 0) break;
1427 fprintf ( stderr, "%c", name[i] );
1434 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1436 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1437 UInt32 strtab_offset = * (UInt32*)(name+4);
1438 strncpy ( dst, strtab+strtab_offset, dstSize );
1444 if (name[i] == 0) break;
1454 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1457 /* If the string is longer than 8 bytes, look in the
1458 string table for it -- this will be correctly zero terminated.
1460 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1461 UInt32 strtab_offset = * (UInt32*)(name+4);
1462 return ((UChar*)strtab) + strtab_offset;
1464 /* Otherwise, if shorter than 8 bytes, return the original,
1465 which by defn is correctly terminated.
1467 if (name[7]==0) return name;
1468 /* The annoying case: 8 bytes. Copy into a temporary
1469 (which is never freed ...)
1471 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1473 strncpy(newstr,name,8);
1479 /* Just compares the short names (first 8 chars) */
1480 static COFF_section *
1481 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1485 = (COFF_header*)(oc->image);
1486 COFF_section* sectab
1488 ((UChar*)(oc->image))
1489 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1491 for (i = 0; i < hdr->NumberOfSections; i++) {
1494 COFF_section* section_i
1496 myindex ( sizeof_COFF_section, sectab, i );
1497 n1 = (UChar*) &(section_i->Name);
1499 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1500 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1501 n1[6]==n2[6] && n1[7]==n2[7])
1510 zapTrailingAtSign ( UChar* sym )
1512 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1514 if (sym[0] == 0) return;
1516 while (sym[i] != 0) i++;
1519 while (j > 0 && my_isdigit(sym[j])) j--;
1520 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1526 ocVerifyImage_PEi386 ( ObjectCode* oc )
1531 COFF_section* sectab;
1532 COFF_symbol* symtab;
1534 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1535 hdr = (COFF_header*)(oc->image);
1536 sectab = (COFF_section*) (
1537 ((UChar*)(oc->image))
1538 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1540 symtab = (COFF_symbol*) (
1541 ((UChar*)(oc->image))
1542 + hdr->PointerToSymbolTable
1544 strtab = ((UChar*)symtab)
1545 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1547 if (hdr->Machine != 0x14c) {
1548 belch("Not x86 PEi386");
1551 if (hdr->SizeOfOptionalHeader != 0) {
1552 belch("PEi386 with nonempty optional header");
1555 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1556 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1557 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1558 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1559 belch("Not a PEi386 object file");
1562 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1563 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1564 belch("Invalid PEi386 word size or endiannness: %d",
1565 (int)(hdr->Characteristics));
1568 /* If the string table size is way crazy, this might indicate that
1569 there are more than 64k relocations, despite claims to the
1570 contrary. Hence this test. */
1571 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1573 if ( (*(UInt32*)strtab) > 600000 ) {
1574 /* Note that 600k has no special significance other than being
1575 big enough to handle the almost-2MB-sized lumps that
1576 constitute HSwin32*.o. */
1577 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1582 /* No further verification after this point; only debug printing. */
1584 IF_DEBUG(linker, i=1);
1585 if (i == 0) return 1;
1588 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1590 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1592 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1594 fprintf ( stderr, "\n" );
1596 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1598 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1600 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1602 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1604 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1606 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1608 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1610 /* Print the section table. */
1611 fprintf ( stderr, "\n" );
1612 for (i = 0; i < hdr->NumberOfSections; i++) {
1614 COFF_section* sectab_i
1616 myindex ( sizeof_COFF_section, sectab, i );
1623 printName ( sectab_i->Name, strtab );
1633 sectab_i->VirtualSize,
1634 sectab_i->VirtualAddress,
1635 sectab_i->SizeOfRawData,
1636 sectab_i->PointerToRawData,
1637 sectab_i->NumberOfRelocations,
1638 sectab_i->PointerToRelocations,
1639 sectab_i->PointerToRawData
1641 reltab = (COFF_reloc*) (
1642 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1645 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1646 /* If the relocation field (a short) has overflowed, the
1647 * real count can be found in the first reloc entry.
1649 * See Section 4.1 (last para) of the PE spec (rev6.0).
1651 COFF_reloc* rel = (COFF_reloc*)
1652 myindex ( sizeof_COFF_reloc, reltab, 0 );
1653 noRelocs = rel->VirtualAddress;
1656 noRelocs = sectab_i->NumberOfRelocations;
1660 for (; j < noRelocs; j++) {
1662 COFF_reloc* rel = (COFF_reloc*)
1663 myindex ( sizeof_COFF_reloc, reltab, j );
1665 " type 0x%-4x vaddr 0x%-8x name `",
1667 rel->VirtualAddress );
1668 sym = (COFF_symbol*)
1669 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1670 /* Hmm..mysterious looking offset - what's it for? SOF */
1671 printName ( sym->Name, strtab -10 );
1672 fprintf ( stderr, "'\n" );
1675 fprintf ( stderr, "\n" );
1677 fprintf ( stderr, "\n" );
1678 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1679 fprintf ( stderr, "---START of string table---\n");
1680 for (i = 4; i < *(Int32*)strtab; i++) {
1682 fprintf ( stderr, "\n"); else
1683 fprintf( stderr, "%c", strtab[i] );
1685 fprintf ( stderr, "--- END of string table---\n");
1687 fprintf ( stderr, "\n" );
1690 COFF_symbol* symtab_i;
1691 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1692 symtab_i = (COFF_symbol*)
1693 myindex ( sizeof_COFF_symbol, symtab, i );
1699 printName ( symtab_i->Name, strtab );
1708 (Int32)(symtab_i->SectionNumber),
1709 (UInt32)symtab_i->Type,
1710 (UInt32)symtab_i->StorageClass,
1711 (UInt32)symtab_i->NumberOfAuxSymbols
1713 i += symtab_i->NumberOfAuxSymbols;
1717 fprintf ( stderr, "\n" );
1723 ocGetNames_PEi386 ( ObjectCode* oc )
1726 COFF_section* sectab;
1727 COFF_symbol* symtab;
1734 hdr = (COFF_header*)(oc->image);
1735 sectab = (COFF_section*) (
1736 ((UChar*)(oc->image))
1737 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1739 symtab = (COFF_symbol*) (
1740 ((UChar*)(oc->image))
1741 + hdr->PointerToSymbolTable
1743 strtab = ((UChar*)(oc->image))
1744 + hdr->PointerToSymbolTable
1745 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1747 /* Allocate space for any (local, anonymous) .bss sections. */
1749 for (i = 0; i < hdr->NumberOfSections; i++) {
1751 COFF_section* sectab_i
1753 myindex ( sizeof_COFF_section, sectab, i );
1754 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1755 if (sectab_i->VirtualSize == 0) continue;
1756 /* This is a non-empty .bss section. Allocate zeroed space for
1757 it, and set its PointerToRawData field such that oc->image +
1758 PointerToRawData == addr_of_zeroed_space. */
1759 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1760 "ocGetNames_PEi386(anonymous bss)");
1761 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1762 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1763 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1766 /* Copy section information into the ObjectCode. */
1768 for (i = 0; i < hdr->NumberOfSections; i++) {
1774 = SECTIONKIND_OTHER;
1775 COFF_section* sectab_i
1777 myindex ( sizeof_COFF_section, sectab, i );
1778 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1781 /* I'm sure this is the Right Way to do it. However, the
1782 alternative of testing the sectab_i->Name field seems to
1783 work ok with Cygwin.
1785 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1786 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1787 kind = SECTIONKIND_CODE_OR_RODATA;
1790 if (0==strcmp(".text",sectab_i->Name) ||
1791 0==strcmp(".rodata",sectab_i->Name))
1792 kind = SECTIONKIND_CODE_OR_RODATA;
1793 if (0==strcmp(".data",sectab_i->Name) ||
1794 0==strcmp(".bss",sectab_i->Name))
1795 kind = SECTIONKIND_RWDATA;
1797 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1798 sz = sectab_i->SizeOfRawData;
1799 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1801 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1802 end = start + sz - 1;
1804 if (kind == SECTIONKIND_OTHER
1805 /* Ignore sections called which contain stabs debugging
1807 && 0 != strcmp(".stab", sectab_i->Name)
1808 && 0 != strcmp(".stabstr", sectab_i->Name)
1810 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1814 if (kind != SECTIONKIND_OTHER && end >= start) {
1815 addSection(oc, kind, start, end);
1816 addProddableBlock(oc, start, end - start + 1);
1820 /* Copy exported symbols into the ObjectCode. */
1822 oc->n_symbols = hdr->NumberOfSymbols;
1823 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1824 "ocGetNames_PEi386(oc->symbols)");
1825 /* Call me paranoid; I don't care. */
1826 for (i = 0; i < oc->n_symbols; i++)
1827 oc->symbols[i] = NULL;
1831 COFF_symbol* symtab_i;
1832 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1833 symtab_i = (COFF_symbol*)
1834 myindex ( sizeof_COFF_symbol, symtab, i );
1838 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1839 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1840 /* This symbol is global and defined, viz, exported */
1841 /* for MYIMAGE_SYMCLASS_EXTERNAL
1842 && !MYIMAGE_SYM_UNDEFINED,
1843 the address of the symbol is:
1844 address of relevant section + offset in section
1846 COFF_section* sectabent
1847 = (COFF_section*) myindex ( sizeof_COFF_section,
1849 symtab_i->SectionNumber-1 );
1850 addr = ((UChar*)(oc->image))
1851 + (sectabent->PointerToRawData
1855 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1856 && symtab_i->Value > 0) {
1857 /* This symbol isn't in any section at all, ie, global bss.
1858 Allocate zeroed space for it. */
1859 addr = stgCallocBytes(1, symtab_i->Value,
1860 "ocGetNames_PEi386(non-anonymous bss)");
1861 addSection(oc, SECTIONKIND_RWDATA, addr,
1862 ((UChar*)addr) + symtab_i->Value - 1);
1863 addProddableBlock(oc, addr, symtab_i->Value);
1864 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1867 if (addr != NULL ) {
1868 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1869 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1870 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1871 ASSERT(i >= 0 && i < oc->n_symbols);
1872 /* cstring_from_COFF_symbol_name always succeeds. */
1873 oc->symbols[i] = sname;
1874 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1878 "IGNORING symbol %d\n"
1882 printName ( symtab_i->Name, strtab );
1891 (Int32)(symtab_i->SectionNumber),
1892 (UInt32)symtab_i->Type,
1893 (UInt32)symtab_i->StorageClass,
1894 (UInt32)symtab_i->NumberOfAuxSymbols
1899 i += symtab_i->NumberOfAuxSymbols;
1908 ocResolve_PEi386 ( ObjectCode* oc )
1911 COFF_section* sectab;
1912 COFF_symbol* symtab;
1922 /* ToDo: should be variable-sized? But is at least safe in the
1923 sense of buffer-overrun-proof. */
1925 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1927 hdr = (COFF_header*)(oc->image);
1928 sectab = (COFF_section*) (
1929 ((UChar*)(oc->image))
1930 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1932 symtab = (COFF_symbol*) (
1933 ((UChar*)(oc->image))
1934 + hdr->PointerToSymbolTable
1936 strtab = ((UChar*)(oc->image))
1937 + hdr->PointerToSymbolTable
1938 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1940 for (i = 0; i < hdr->NumberOfSections; i++) {
1941 COFF_section* sectab_i
1943 myindex ( sizeof_COFF_section, sectab, i );
1946 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1949 /* Ignore sections called which contain stabs debugging
1951 if (0 == strcmp(".stab", sectab_i->Name)
1952 || 0 == strcmp(".stabstr", sectab_i->Name))
1955 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1956 /* If the relocation field (a short) has overflowed, the
1957 * real count can be found in the first reloc entry.
1959 * See Section 4.1 (last para) of the PE spec (rev6.0).
1961 * Nov2003 update: the GNU linker still doesn't correctly
1962 * handle the generation of relocatable object files with
1963 * overflown relocations. Hence the output to warn of potential
1966 COFF_reloc* rel = (COFF_reloc*)
1967 myindex ( sizeof_COFF_reloc, reltab, 0 );
1968 noRelocs = rel->VirtualAddress;
1969 fprintf(stderr, "WARNING: Overflown relocation field (# relocs found: %u)\n", noRelocs); fflush(stderr);
1972 noRelocs = sectab_i->NumberOfRelocations;
1977 for (; j < noRelocs; j++) {
1979 COFF_reloc* reltab_j
1981 myindex ( sizeof_COFF_reloc, reltab, j );
1983 /* the location to patch */
1985 ((UChar*)(oc->image))
1986 + (sectab_i->PointerToRawData
1987 + reltab_j->VirtualAddress
1988 - sectab_i->VirtualAddress )
1990 /* the existing contents of pP */
1992 /* the symbol to connect to */
1993 sym = (COFF_symbol*)
1994 myindex ( sizeof_COFF_symbol,
1995 symtab, reltab_j->SymbolTableIndex );
1998 "reloc sec %2d num %3d: type 0x%-4x "
1999 "vaddr 0x%-8x name `",
2001 (UInt32)reltab_j->Type,
2002 reltab_j->VirtualAddress );
2003 printName ( sym->Name, strtab );
2004 fprintf ( stderr, "'\n" ));
2006 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2007 COFF_section* section_sym
2008 = findPEi386SectionCalled ( oc, sym->Name );
2010 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
2013 S = ((UInt32)(oc->image))
2014 + (section_sym->PointerToRawData
2017 copyName ( sym->Name, strtab, symbol, 1000-1 );
2018 (void*)S = lookupLocalSymbol( oc, symbol );
2019 if ((void*)S != NULL) goto foundit;
2020 (void*)S = lookupSymbol( symbol );
2021 if ((void*)S != NULL) goto foundit;
2022 zapTrailingAtSign ( symbol );
2023 (void*)S = lookupLocalSymbol( oc, symbol );
2024 if ((void*)S != NULL) goto foundit;
2025 (void*)S = lookupSymbol( symbol );
2026 if ((void*)S != NULL) goto foundit;
2027 /* Newline first because the interactive linker has printed "linking..." */
2028 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2032 checkProddableBlock(oc, pP);
2033 switch (reltab_j->Type) {
2034 case MYIMAGE_REL_I386_DIR32:
2037 case MYIMAGE_REL_I386_REL32:
2038 /* Tricky. We have to insert a displacement at
2039 pP which, when added to the PC for the _next_
2040 insn, gives the address of the target (S).
2041 Problem is to know the address of the next insn
2042 when we only know pP. We assume that this
2043 literal field is always the last in the insn,
2044 so that the address of the next insn is pP+4
2045 -- hence the constant 4.
2046 Also I don't know if A should be added, but so
2047 far it has always been zero.
2050 *pP = S - ((UInt32)pP) - 4;
2053 belch("%s: unhandled PEi386 relocation type %d",
2054 oc->fileName, reltab_j->Type);
2061 IF_DEBUG(linker, belch("completed %s", oc->fileName));
2065 #endif /* defined(OBJFORMAT_PEi386) */
2068 /* --------------------------------------------------------------------------
2070 * ------------------------------------------------------------------------*/
2072 #if defined(OBJFORMAT_ELF)
2077 #if defined(sparc_TARGET_ARCH)
2078 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2079 #elif defined(i386_TARGET_ARCH)
2080 # define ELF_TARGET_386 /* Used inside <elf.h> */
2081 #elif defined(x86_64_TARGET_ARCH)
2082 # define ELF_TARGET_X64_64
2084 #elif defined (ia64_TARGET_ARCH)
2085 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2087 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2088 # define ELF_NEED_GOT /* needs Global Offset Table */
2089 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2092 #if !defined(openbsd_TARGET_OS)
2095 /* openbsd elf has things in different places, with diff names */
2096 #include <elf_abi.h>
2097 #include <machine/reloc.h>
2098 #define R_386_32 RELOC_32
2099 #define R_386_PC32 RELOC_PC32
2103 * Define a set of types which can be used for both ELF32 and ELF64
2107 #define ELFCLASS ELFCLASS64
2108 #define Elf_Addr Elf64_Addr
2109 #define Elf_Word Elf64_Word
2110 #define Elf_Sword Elf64_Sword
2111 #define Elf_Ehdr Elf64_Ehdr
2112 #define Elf_Phdr Elf64_Phdr
2113 #define Elf_Shdr Elf64_Shdr
2114 #define Elf_Sym Elf64_Sym
2115 #define Elf_Rel Elf64_Rel
2116 #define Elf_Rela Elf64_Rela
2117 #define ELF_ST_TYPE ELF64_ST_TYPE
2118 #define ELF_ST_BIND ELF64_ST_BIND
2119 #define ELF_R_TYPE ELF64_R_TYPE
2120 #define ELF_R_SYM ELF64_R_SYM
2122 #define ELFCLASS ELFCLASS32
2123 #define Elf_Addr Elf32_Addr
2124 #define Elf_Word Elf32_Word
2125 #define Elf_Sword Elf32_Sword
2126 #define Elf_Ehdr Elf32_Ehdr
2127 #define Elf_Phdr Elf32_Phdr
2128 #define Elf_Shdr Elf32_Shdr
2129 #define Elf_Sym Elf32_Sym
2130 #define Elf_Rel Elf32_Rel
2131 #define Elf_Rela Elf32_Rela
2133 #define ELF_ST_TYPE ELF32_ST_TYPE
2136 #define ELF_ST_BIND ELF32_ST_BIND
2139 #define ELF_R_TYPE ELF32_R_TYPE
2142 #define ELF_R_SYM ELF32_R_SYM
2148 * Functions to allocate entries in dynamic sections. Currently we simply
2149 * preallocate a large number, and we don't check if a entry for the given
2150 * target already exists (a linear search is too slow). Ideally these
2151 * entries would be associated with symbols.
2154 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2155 #define GOT_SIZE 0x20000
2156 #define FUNCTION_TABLE_SIZE 0x10000
2157 #define PLT_SIZE 0x08000
2160 static Elf_Addr got[GOT_SIZE];
2161 static unsigned int gotIndex;
2162 static Elf_Addr gp_val = (Elf_Addr)got;
2165 allocateGOTEntry(Elf_Addr target)
2169 if (gotIndex >= GOT_SIZE)
2170 barf("Global offset table overflow");
2172 entry = &got[gotIndex++];
2174 return (Elf_Addr)entry;
2178 #ifdef ELF_FUNCTION_DESC
2184 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2185 static unsigned int functionTableIndex;
2188 allocateFunctionDesc(Elf_Addr target)
2190 FunctionDesc *entry;
2192 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2193 barf("Function table overflow");
2195 entry = &functionTable[functionTableIndex++];
2197 entry->gp = (Elf_Addr)gp_val;
2198 return (Elf_Addr)entry;
2202 copyFunctionDesc(Elf_Addr target)
2204 FunctionDesc *olddesc = (FunctionDesc *)target;
2205 FunctionDesc *newdesc;
2207 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2208 newdesc->gp = olddesc->gp;
2209 return (Elf_Addr)newdesc;
2214 #ifdef ia64_TARGET_ARCH
2215 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2216 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2218 static unsigned char plt_code[] =
2220 /* taken from binutils bfd/elfxx-ia64.c */
2221 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2222 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2223 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2224 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2225 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2226 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2229 /* If we can't get to the function descriptor via gp, take a local copy of it */
2230 #define PLT_RELOC(code, target) { \
2231 Elf64_Sxword rel_value = target - gp_val; \
2232 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2233 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2235 ia64_reloc_gprel22((Elf_Addr)code, target); \
2240 unsigned char code[sizeof(plt_code)];
2244 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2246 PLTEntry *plt = (PLTEntry *)oc->plt;
2249 if (oc->pltIndex >= PLT_SIZE)
2250 barf("Procedure table overflow");
2252 entry = &plt[oc->pltIndex++];
2253 memcpy(entry->code, plt_code, sizeof(entry->code));
2254 PLT_RELOC(entry->code, target);
2255 return (Elf_Addr)entry;
2261 return (PLT_SIZE * sizeof(PLTEntry));
2267 * Generic ELF functions
2271 findElfSection ( void* objImage, Elf_Word sh_type )
2273 char* ehdrC = (char*)objImage;
2274 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2275 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2276 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2280 for (i = 0; i < ehdr->e_shnum; i++) {
2281 if (shdr[i].sh_type == sh_type
2282 /* Ignore the section header's string table. */
2283 && i != ehdr->e_shstrndx
2284 /* Ignore string tables named .stabstr, as they contain
2286 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2288 ptr = ehdrC + shdr[i].sh_offset;
2295 #if defined(ia64_TARGET_ARCH)
2297 findElfSegment ( void* objImage, Elf_Addr vaddr )
2299 char* ehdrC = (char*)objImage;
2300 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2301 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2302 Elf_Addr segaddr = 0;
2305 for (i = 0; i < ehdr->e_phnum; i++) {
2306 segaddr = phdr[i].p_vaddr;
2307 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2315 ocVerifyImage_ELF ( ObjectCode* oc )
2319 int i, j, nent, nstrtab, nsymtabs;
2323 char* ehdrC = (char*)(oc->image);
2324 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2326 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2327 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2328 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2329 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2330 belch("%s: not an ELF object", oc->fileName);
2334 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2335 belch("%s: unsupported ELF format", oc->fileName);
2339 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2340 IF_DEBUG(linker,belch( "Is little-endian" ));
2342 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2343 IF_DEBUG(linker,belch( "Is big-endian" ));
2345 belch("%s: unknown endiannness", oc->fileName);
2349 if (ehdr->e_type != ET_REL) {
2350 belch("%s: not a relocatable object (.o) file", oc->fileName);
2353 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2355 IF_DEBUG(linker,belch( "Architecture is " ));
2356 switch (ehdr->e_machine) {
2357 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2358 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2360 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2362 default: IF_DEBUG(linker,belch( "unknown" ));
2363 belch("%s: unknown architecture", oc->fileName);
2367 IF_DEBUG(linker,belch(
2368 "\nSection header table: start %d, n_entries %d, ent_size %d",
2369 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2371 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2373 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2375 if (ehdr->e_shstrndx == SHN_UNDEF) {
2376 belch("%s: no section header string table", oc->fileName);
2379 IF_DEBUG(linker,belch( "Section header string table is section %d",
2381 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2384 for (i = 0; i < ehdr->e_shnum; i++) {
2385 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2386 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2387 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2388 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2389 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2390 ehdrC + shdr[i].sh_offset,
2391 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2393 if (shdr[i].sh_type == SHT_REL) {
2394 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2395 } else if (shdr[i].sh_type == SHT_RELA) {
2396 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2398 IF_DEBUG(linker,fprintf(stderr," "));
2401 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2405 IF_DEBUG(linker,belch( "\nString tables" ));
2408 for (i = 0; i < ehdr->e_shnum; i++) {
2409 if (shdr[i].sh_type == SHT_STRTAB
2410 /* Ignore the section header's string table. */
2411 && i != ehdr->e_shstrndx
2412 /* Ignore string tables named .stabstr, as they contain
2414 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2416 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2417 strtab = ehdrC + shdr[i].sh_offset;
2422 belch("%s: no string tables, or too many", oc->fileName);
2427 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2428 for (i = 0; i < ehdr->e_shnum; i++) {
2429 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2430 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2432 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2433 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2434 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2436 shdr[i].sh_size % sizeof(Elf_Sym)
2438 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2439 belch("%s: non-integral number of symbol table entries", oc->fileName);
2442 for (j = 0; j < nent; j++) {
2443 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2444 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2445 (int)stab[j].st_shndx,
2446 (int)stab[j].st_size,
2447 (char*)stab[j].st_value ));
2449 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2450 switch (ELF_ST_TYPE(stab[j].st_info)) {
2451 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2452 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2453 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2454 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2455 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2456 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2458 IF_DEBUG(linker,fprintf(stderr, " " ));
2460 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2461 switch (ELF_ST_BIND(stab[j].st_info)) {
2462 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2463 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2464 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2465 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2467 IF_DEBUG(linker,fprintf(stderr, " " ));
2469 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2473 if (nsymtabs == 0) {
2474 belch("%s: didn't find any symbol tables", oc->fileName);
2483 ocGetNames_ELF ( ObjectCode* oc )
2488 char* ehdrC = (char*)(oc->image);
2489 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2490 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2491 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2493 ASSERT(symhash != NULL);
2496 belch("%s: no strtab", oc->fileName);
2501 for (i = 0; i < ehdr->e_shnum; i++) {
2502 /* Figure out what kind of section it is. Logic derived from
2503 Figure 1.14 ("Special Sections") of the ELF document
2504 ("Portable Formats Specification, Version 1.1"). */
2505 Elf_Shdr hdr = shdr[i];
2506 SectionKind kind = SECTIONKIND_OTHER;
2509 if (hdr.sh_type == SHT_PROGBITS
2510 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2511 /* .text-style section */
2512 kind = SECTIONKIND_CODE_OR_RODATA;
2515 if (hdr.sh_type == SHT_PROGBITS
2516 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2517 /* .data-style section */
2518 kind = SECTIONKIND_RWDATA;
2521 if (hdr.sh_type == SHT_PROGBITS
2522 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2523 /* .rodata-style section */
2524 kind = SECTIONKIND_CODE_OR_RODATA;
2527 if (hdr.sh_type == SHT_NOBITS
2528 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2529 /* .bss-style section */
2530 kind = SECTIONKIND_RWDATA;
2534 if (is_bss && shdr[i].sh_size > 0) {
2535 /* This is a non-empty .bss section. Allocate zeroed space for
2536 it, and set its .sh_offset field such that
2537 ehdrC + .sh_offset == addr_of_zeroed_space. */
2538 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2539 "ocGetNames_ELF(BSS)");
2540 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2542 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2543 zspace, shdr[i].sh_size);
2547 /* fill in the section info */
2548 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2549 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2550 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2551 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2554 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2556 /* copy stuff into this module's object symbol table */
2557 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2558 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2560 oc->n_symbols = nent;
2561 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2562 "ocGetNames_ELF(oc->symbols)");
2564 for (j = 0; j < nent; j++) {
2566 char isLocal = FALSE; /* avoids uninit-var warning */
2568 char* nm = strtab + stab[j].st_name;
2569 int secno = stab[j].st_shndx;
2571 /* Figure out if we want to add it; if so, set ad to its
2572 address. Otherwise leave ad == NULL. */
2574 if (secno == SHN_COMMON) {
2576 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2578 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2579 stab[j].st_size, nm);
2581 /* Pointless to do addProddableBlock() for this area,
2582 since the linker should never poke around in it. */
2585 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2586 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2588 /* and not an undefined symbol */
2589 && stab[j].st_shndx != SHN_UNDEF
2590 /* and not in a "special section" */
2591 && stab[j].st_shndx < SHN_LORESERVE
2593 /* and it's a not a section or string table or anything silly */
2594 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2595 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2596 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2599 /* Section 0 is the undefined section, hence > and not >=. */
2600 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2602 if (shdr[secno].sh_type == SHT_NOBITS) {
2603 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2604 stab[j].st_size, stab[j].st_value, nm);
2607 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2608 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2611 #ifdef ELF_FUNCTION_DESC
2612 /* dlsym() and the initialisation table both give us function
2613 * descriptors, so to be consistent we store function descriptors
2614 * in the symbol table */
2615 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2616 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2618 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2619 ad, oc->fileName, nm ));
2624 /* And the decision is ... */
2628 oc->symbols[j] = nm;
2631 /* Ignore entirely. */
2633 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2637 IF_DEBUG(linker,belch( "skipping `%s'",
2638 strtab + stab[j].st_name ));
2641 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2642 (int)ELF_ST_BIND(stab[j].st_info),
2643 (int)ELF_ST_TYPE(stab[j].st_info),
2644 (int)stab[j].st_shndx,
2645 strtab + stab[j].st_name
2648 oc->symbols[j] = NULL;
2657 /* Do ELF relocations which lack an explicit addend. All x86-linux
2658 relocations appear to be of this form. */
2660 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2661 Elf_Shdr* shdr, int shnum,
2662 Elf_Sym* stab, char* strtab )
2667 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2668 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2669 int target_shndx = shdr[shnum].sh_info;
2670 int symtab_shndx = shdr[shnum].sh_link;
2672 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2673 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2674 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2675 target_shndx, symtab_shndx ));
2677 for (j = 0; j < nent; j++) {
2678 Elf_Addr offset = rtab[j].r_offset;
2679 Elf_Addr info = rtab[j].r_info;
2681 Elf_Addr P = ((Elf_Addr)targ) + offset;
2682 Elf_Word* pP = (Elf_Word*)P;
2687 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2688 j, (void*)offset, (void*)info ));
2690 IF_DEBUG(linker,belch( " ZERO" ));
2693 Elf_Sym sym = stab[ELF_R_SYM(info)];
2694 /* First see if it is a local symbol. */
2695 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2696 /* Yes, so we can get the address directly from the ELF symbol
2698 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2700 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2701 + stab[ELF_R_SYM(info)].st_value);
2704 /* No, so look up the name in our global table. */
2705 symbol = strtab + sym.st_name;
2706 (void*)S = lookupSymbol( symbol );
2709 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2712 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2715 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2716 (void*)P, (void*)S, (void*)A ));
2717 checkProddableBlock ( oc, pP );
2721 switch (ELF_R_TYPE(info)) {
2722 # ifdef i386_TARGET_ARCH
2723 case R_386_32: *pP = value; break;
2724 case R_386_PC32: *pP = value - P; break;
2727 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2728 oc->fileName, ELF_R_TYPE(info));
2736 /* Do ELF relocations for which explicit addends are supplied.
2737 sparc-solaris relocations appear to be of this form. */
2739 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2740 Elf_Shdr* shdr, int shnum,
2741 Elf_Sym* stab, char* strtab )
2746 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2747 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2748 int target_shndx = shdr[shnum].sh_info;
2749 int symtab_shndx = shdr[shnum].sh_link;
2751 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2752 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2753 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2754 target_shndx, symtab_shndx ));
2756 for (j = 0; j < nent; j++) {
2757 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2758 /* This #ifdef only serves to avoid unused-var warnings. */
2759 Elf_Addr offset = rtab[j].r_offset;
2760 Elf_Addr P = targ + offset;
2762 Elf_Addr info = rtab[j].r_info;
2763 Elf_Addr A = rtab[j].r_addend;
2766 # if defined(sparc_TARGET_ARCH)
2767 Elf_Word* pP = (Elf_Word*)P;
2769 # elif defined(ia64_TARGET_ARCH)
2770 Elf64_Xword *pP = (Elf64_Xword *)P;
2774 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2775 j, (void*)offset, (void*)info,
2778 IF_DEBUG(linker,belch( " ZERO" ));
2781 Elf_Sym sym = stab[ELF_R_SYM(info)];
2782 /* First see if it is a local symbol. */
2783 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2784 /* Yes, so we can get the address directly from the ELF symbol
2786 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2788 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2789 + stab[ELF_R_SYM(info)].st_value);
2790 #ifdef ELF_FUNCTION_DESC
2791 /* Make a function descriptor for this function */
2792 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2793 S = allocateFunctionDesc(S + A);
2798 /* No, so look up the name in our global table. */
2799 symbol = strtab + sym.st_name;
2800 (void*)S = lookupSymbol( symbol );
2802 #ifdef ELF_FUNCTION_DESC
2803 /* If a function, already a function descriptor - we would
2804 have to copy it to add an offset. */
2805 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2806 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2810 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2813 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2816 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2817 (void*)P, (void*)S, (void*)A ));
2818 /* checkProddableBlock ( oc, (void*)P ); */
2822 switch (ELF_R_TYPE(info)) {
2823 # if defined(sparc_TARGET_ARCH)
2824 case R_SPARC_WDISP30:
2825 w1 = *pP & 0xC0000000;
2826 w2 = (Elf_Word)((value - P) >> 2);
2827 ASSERT((w2 & 0xC0000000) == 0);
2832 w1 = *pP & 0xFFC00000;
2833 w2 = (Elf_Word)(value >> 10);
2834 ASSERT((w2 & 0xFFC00000) == 0);
2840 w2 = (Elf_Word)(value & 0x3FF);
2841 ASSERT((w2 & ~0x3FF) == 0);
2845 /* According to the Sun documentation:
2847 This relocation type resembles R_SPARC_32, except it refers to an
2848 unaligned word. That is, the word to be relocated must be treated
2849 as four separate bytes with arbitrary alignment, not as a word
2850 aligned according to the architecture requirements.
2852 (JRS: which means that freeloading on the R_SPARC_32 case
2853 is probably wrong, but hey ...)
2857 w2 = (Elf_Word)value;
2860 # elif defined(ia64_TARGET_ARCH)
2861 case R_IA64_DIR64LSB:
2862 case R_IA64_FPTR64LSB:
2865 case R_IA64_PCREL64LSB:
2868 case R_IA64_SEGREL64LSB:
2869 addr = findElfSegment(ehdrC, value);
2872 case R_IA64_GPREL22:
2873 ia64_reloc_gprel22(P, value);
2875 case R_IA64_LTOFF22:
2876 case R_IA64_LTOFF22X:
2877 case R_IA64_LTOFF_FPTR22:
2878 addr = allocateGOTEntry(value);
2879 ia64_reloc_gprel22(P, addr);
2881 case R_IA64_PCREL21B:
2882 ia64_reloc_pcrel21(P, S, oc);
2885 /* This goes with R_IA64_LTOFF22X and points to the load to
2886 * convert into a move. We don't implement relaxation. */
2890 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2891 oc->fileName, ELF_R_TYPE(info));
2900 ocResolve_ELF ( ObjectCode* oc )
2904 Elf_Sym* stab = NULL;
2905 char* ehdrC = (char*)(oc->image);
2906 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2907 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2908 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2910 /* first find "the" symbol table */
2911 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2913 /* also go find the string table */
2914 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2916 if (stab == NULL || strtab == NULL) {
2917 belch("%s: can't find string or symbol table", oc->fileName);
2921 /* Process the relocation sections. */
2922 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2924 /* Skip sections called ".rel.stab". These appear to contain
2925 relocation entries that, when done, make the stabs debugging
2926 info point at the right places. We ain't interested in all
2928 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2931 if (shdr[shnum].sh_type == SHT_REL ) {
2932 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2933 shnum, stab, strtab );
2937 if (shdr[shnum].sh_type == SHT_RELA) {
2938 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2939 shnum, stab, strtab );
2944 /* Free the local symbol table; we won't need it again. */
2945 freeHashTable(oc->lochash, NULL);
2953 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2954 * at the front. The following utility functions pack and unpack instructions, and
2955 * take care of the most common relocations.
2958 #ifdef ia64_TARGET_ARCH
2961 ia64_extract_instruction(Elf64_Xword *target)
2964 int slot = (Elf_Addr)target & 3;
2965 (Elf_Addr)target &= ~3;
2973 return ((w1 >> 5) & 0x1ffffffffff);
2975 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2979 barf("ia64_extract_instruction: invalid slot %p", target);
2984 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2986 int slot = (Elf_Addr)target & 3;
2987 (Elf_Addr)target &= ~3;
2992 *target |= value << 5;
2995 *target |= value << 46;
2996 *(target+1) |= value >> 18;
2999 *(target+1) |= value << 23;
3005 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3007 Elf64_Xword instruction;
3008 Elf64_Sxword rel_value;
3010 rel_value = value - gp_val;
3011 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3012 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3014 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3015 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3016 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3017 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3018 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3019 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3023 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3025 Elf64_Xword instruction;
3026 Elf64_Sxword rel_value;
3029 entry = allocatePLTEntry(value, oc);
3031 rel_value = (entry >> 4) - (target >> 4);
3032 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3033 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3035 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3036 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3037 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3038 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3045 /* --------------------------------------------------------------------------
3047 * ------------------------------------------------------------------------*/
3049 #if defined(OBJFORMAT_MACHO)
3052 Support for MachO linking on Darwin/MacOS X on PowerPC chips
3053 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3055 I hereby formally apologize for the hackish nature of this code.
3056 Things that need to be done:
3057 *) implement ocVerifyImage_MachO
3058 *) add still more sanity checks.
3063 ocAllocateJumpIslands_MachO
3065 Allocate additional space at the end of the object file image to make room
3068 PowerPC relative branch instructions have a 24 bit displacement field.
3069 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
3070 If a particular imported symbol is outside this range, we have to redirect
3071 the jump to a short piece of new code that just loads the 32bit absolute
3072 address and jumps there.
3073 This function just allocates space for one 16 byte jump island for every
3074 undefined symbol in the object file. The code for the islands is filled in by
3075 makeJumpIsland below.
3078 static const int islandSize = 16;
3080 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3082 char *image = (char*) oc->image;
3083 struct mach_header *header = (struct mach_header*) image;
3084 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3087 for(i=0;i<header->ncmds;i++)
3089 if(lc->cmd == LC_DYSYMTAB)
3091 struct dysymtab_command *dsymLC = (struct dysymtab_command*) lc;
3092 unsigned long nundefsym = dsymLC->nundefsym;
3093 oc->island_start_symbol = dsymLC->iundefsym;
3094 oc->n_islands = nundefsym;
3099 #error ocAllocateJumpIslands_MachO doesnt want USE_MMAP to be defined
3101 oc->image = stgReallocBytes(
3102 image, oc->fileSize + islandSize * nundefsym,
3103 "ocAllocateJumpIslands_MachO");
3105 oc->jump_islands = oc->image + oc->fileSize;
3106 memset(oc->jump_islands, 0, islandSize * nundefsym);
3109 break; // there can be only one LC_DSYMTAB
3111 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3116 static int ocVerifyImage_MachO(ObjectCode* oc)
3118 // FIXME: do some verifying here
3122 static int resolveImports(
3125 struct symtab_command *symLC,
3126 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3127 unsigned long *indirectSyms,
3128 struct nlist *nlist)
3132 for(i=0;i*4<sect->size;i++)
3134 // according to otool, reserved1 contains the first index into the indirect symbol table
3135 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3136 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3139 if((symbol->n_type & N_TYPE) == N_UNDF
3140 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3141 addr = (void*) (symbol->n_value);
3142 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3145 addr = lookupSymbol(nm);
3148 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3152 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3153 ((void**)(image + sect->offset))[i] = addr;
3159 static void* makeJumpIsland(
3161 unsigned long symbolNumber,
3164 if(symbolNumber < oc->island_start_symbol ||
3165 symbolNumber - oc->island_start_symbol > oc->n_islands)
3167 symbolNumber -= oc->island_start_symbol;
3169 void *island = (void*) ((char*)oc->jump_islands + islandSize * symbolNumber);
3170 unsigned long *p = (unsigned long*) island;
3172 // lis r12, hi16(target)
3173 *p++ = 0x3d800000 | ( ((unsigned long) target) >> 16 );
3174 // ori r12, r12, lo16(target)
3175 *p++ = 0x618c0000 | ( ((unsigned long) target) & 0xFFFF );
3181 return (void*) island;
3184 static char* relocateAddress(
3187 struct section* sections,
3188 unsigned long address)
3191 for(i = 0; i < nSections; i++)
3193 if(sections[i].addr <= address
3194 && address < sections[i].addr + sections[i].size)
3196 return oc->image + sections[i].offset + address - sections[i].addr;
3199 barf("Invalid Mach-O file:"
3200 "Address out of bounds while relocating object file");
3204 static int relocateSection(
3207 struct symtab_command *symLC, struct nlist *nlist,
3208 int nSections, struct section* sections, struct section *sect)
3210 struct relocation_info *relocs;
3213 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3215 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3219 relocs = (struct relocation_info*) (image + sect->reloff);
3223 if(relocs[i].r_address & R_SCATTERED)
3225 struct scattered_relocation_info *scat =
3226 (struct scattered_relocation_info*) &relocs[i];
3230 if(scat->r_length == 2)
3232 unsigned long word = 0;
3233 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3234 checkProddableBlock(oc,wordPtr);
3236 // Step 1: Figure out what the relocated value should be
3237 if(scat->r_type == GENERIC_RELOC_VANILLA)
3239 word = scat->r_value + sect->offset + ((long) image);
3241 else if(scat->r_type == PPC_RELOC_SECTDIFF
3242 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3243 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3244 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3246 struct scattered_relocation_info *pair =
3247 (struct scattered_relocation_info*) &relocs[i+1];
3249 if(!pair->r_scattered || pair->r_type != PPC_RELOC_PAIR)
3250 barf("Invalid Mach-O file: "
3251 "PPC_RELOC_*_SECTDIFF not followed by PPC_RELOC_PAIR");
3253 word = (unsigned long)
3254 (relocateAddress(oc, nSections, sections, scat->r_value)
3255 - relocateAddress(oc, nSections, sections, pair->r_value));
3258 else if(scat->r_type == PPC_RELOC_HI16
3259 || scat->r_type == PPC_RELOC_LO16
3260 || scat->r_type == PPC_RELOC_HA16
3261 || scat->r_type == PPC_RELOC_LO14)
3262 { // these are generated by label+offset things
3263 struct relocation_info *pair = &relocs[i+1];
3264 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3265 barf("Invalid Mach-O file: "
3266 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3268 if(scat->r_type == PPC_RELOC_LO16)
3270 word = ((unsigned short*) wordPtr)[1];
3271 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3273 else if(scat->r_type == PPC_RELOC_LO14)
3275 barf("Unsupported Relocation: PPC_RELOC_LO14");
3276 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3277 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3279 else if(scat->r_type == PPC_RELOC_HI16)
3281 word = ((unsigned short*) wordPtr)[1] << 16;
3282 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3284 else if(scat->r_type == PPC_RELOC_HA16)
3286 word = ((unsigned short*) wordPtr)[1] << 16;
3287 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3291 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3297 continue; // ignore the others
3299 if(scat->r_type == GENERIC_RELOC_VANILLA
3300 || scat->r_type == PPC_RELOC_SECTDIFF)
3304 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3306 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3308 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3310 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3312 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3314 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3315 + ((word & (1<<15)) ? 1 : 0);
3320 continue; // FIXME: I hope it's OK to ignore all the others.
3324 struct relocation_info *reloc = &relocs[i];
3325 if(reloc->r_pcrel && !reloc->r_extern)
3328 if(reloc->r_length == 2)
3330 unsigned long word = 0;
3331 unsigned long jumpIsland = 0;
3332 long offsetToJumpIsland;
3334 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3335 checkProddableBlock(oc,wordPtr);
3337 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3341 else if(reloc->r_type == PPC_RELOC_LO16)
3343 word = ((unsigned short*) wordPtr)[1];
3344 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3346 else if(reloc->r_type == PPC_RELOC_HI16)
3348 word = ((unsigned short*) wordPtr)[1] << 16;
3349 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3351 else if(reloc->r_type == PPC_RELOC_HA16)
3353 word = ((unsigned short*) wordPtr)[1] << 16;
3354 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3356 else if(reloc->r_type == PPC_RELOC_BR24)
3359 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3363 if(!reloc->r_extern)
3366 sections[reloc->r_symbolnum-1].offset
3367 - sections[reloc->r_symbolnum-1].addr
3374 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3375 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3376 unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
3379 belch("\nunknown symbol `%s'", nm);
3386 word = symbolAddress;
3387 jumpIsland = (long) makeJumpIsland(oc,reloc->r_symbolnum,(void*)word);
3388 word -= ((long)image) + sect->offset + reloc->r_address;
3391 offsetToJumpIsland = jumpIsland
3392 - (((long)image) + sect->offset + reloc->r_address);
3397 word += symbolAddress;
3401 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3406 else if(reloc->r_type == PPC_RELOC_LO16)
3408 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3411 else if(reloc->r_type == PPC_RELOC_HI16)
3413 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3416 else if(reloc->r_type == PPC_RELOC_HA16)
3418 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3419 + ((word & (1<<15)) ? 1 : 0);
3422 else if(reloc->r_type == PPC_RELOC_BR24)
3424 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3426 // The branch offset is too large.
3427 // Therefore, we try to use a jump island.
3429 barf("unconditional relative branch out of range: "
3430 "no jump island available");
3432 word = offsetToJumpIsland;
3433 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
3434 barf("unconditional relative branch out of range: "
3435 "jump island out of range");
3437 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3441 barf("\nunknown relocation %d",reloc->r_type);
3448 static int ocGetNames_MachO(ObjectCode* oc)
3450 char *image = (char*) oc->image;
3451 struct mach_header *header = (struct mach_header*) image;
3452 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3453 unsigned i,curSymbol;
3454 struct segment_command *segLC = NULL;
3455 struct section *sections;
3456 struct symtab_command *symLC = NULL;
3457 struct dysymtab_command *dsymLC = NULL;
3458 struct nlist *nlist;
3459 unsigned long commonSize = 0;
3460 char *commonStorage = NULL;
3461 unsigned long commonCounter;
3463 for(i=0;i<header->ncmds;i++)
3465 if(lc->cmd == LC_SEGMENT)
3466 segLC = (struct segment_command*) lc;
3467 else if(lc->cmd == LC_SYMTAB)
3468 symLC = (struct symtab_command*) lc;
3469 else if(lc->cmd == LC_DYSYMTAB)
3470 dsymLC = (struct dysymtab_command*) lc;
3471 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3474 sections = (struct section*) (segLC+1);
3475 nlist = (struct nlist*) (image + symLC->symoff);
3477 for(i=0;i<segLC->nsects;i++)
3479 if(sections[i].size == 0)
3482 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
3484 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
3485 "ocGetNames_MachO(common symbols)");
3486 sections[i].offset = zeroFillArea - image;
3489 if(!strcmp(sections[i].sectname,"__text"))
3490 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3491 (void*) (image + sections[i].offset),
3492 (void*) (image + sections[i].offset + sections[i].size));
3493 else if(!strcmp(sections[i].sectname,"__const"))
3494 addSection(oc, SECTIONKIND_RWDATA,
3495 (void*) (image + sections[i].offset),
3496 (void*) (image + sections[i].offset + sections[i].size));
3497 else if(!strcmp(sections[i].sectname,"__data"))
3498 addSection(oc, SECTIONKIND_RWDATA,
3499 (void*) (image + sections[i].offset),
3500 (void*) (image + sections[i].offset + sections[i].size));
3501 else if(!strcmp(sections[i].sectname,"__bss")
3502 || !strcmp(sections[i].sectname,"__common"))
3503 addSection(oc, SECTIONKIND_RWDATA,
3504 (void*) (image + sections[i].offset),
3505 (void*) (image + sections[i].offset + sections[i].size));
3507 addProddableBlock(oc, (void*) (image + sections[i].offset),
3511 // count external symbols defined here
3513 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3515 if((nlist[i].n_type & N_TYPE) == N_SECT)
3518 for(i=0;i<symLC->nsyms;i++)
3520 if((nlist[i].n_type & N_TYPE) == N_UNDF
3521 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3523 commonSize += nlist[i].n_value;
3527 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3528 "ocGetNames_MachO(oc->symbols)");
3530 // insert symbols into hash table
3531 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3533 if((nlist[i].n_type & N_TYPE) == N_SECT)
3535 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3536 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3537 sections[nlist[i].n_sect-1].offset
3538 - sections[nlist[i].n_sect-1].addr
3539 + nlist[i].n_value);
3540 oc->symbols[curSymbol++] = nm;
3544 // insert local symbols into lochash
3545 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3547 if((nlist[i].n_type & N_TYPE) == N_SECT)
3549 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3550 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3551 sections[nlist[i].n_sect-1].offset
3552 - sections[nlist[i].n_sect-1].addr
3553 + nlist[i].n_value);
3558 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3559 commonCounter = (unsigned long)commonStorage;
3560 for(i=0;i<symLC->nsyms;i++)
3562 if((nlist[i].n_type & N_TYPE) == N_UNDF
3563 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3565 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3566 unsigned long sz = nlist[i].n_value;
3568 nlist[i].n_value = commonCounter;
3570 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3571 oc->symbols[curSymbol++] = nm;
3573 commonCounter += sz;
3579 static int ocResolve_MachO(ObjectCode* oc)
3581 char *image = (char*) oc->image;
3582 struct mach_header *header = (struct mach_header*) image;
3583 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3585 struct segment_command *segLC = NULL;
3586 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3587 struct symtab_command *symLC = NULL;
3588 struct dysymtab_command *dsymLC = NULL;
3589 struct nlist *nlist;
3590 unsigned long *indirectSyms;
3592 for(i=0;i<header->ncmds;i++)
3594 if(lc->cmd == LC_SEGMENT)
3595 segLC = (struct segment_command*) lc;
3596 else if(lc->cmd == LC_SYMTAB)
3597 symLC = (struct symtab_command*) lc;
3598 else if(lc->cmd == LC_DYSYMTAB)
3599 dsymLC = (struct dysymtab_command*) lc;
3600 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3603 sections = (struct section*) (segLC+1);
3604 nlist = (struct nlist*) (image + symLC->symoff);
3606 for(i=0;i<segLC->nsects;i++)
3608 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3609 la_ptrs = §ions[i];
3610 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3611 nl_ptrs = §ions[i];
3614 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3617 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3620 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3623 for(i=0;i<segLC->nsects;i++)
3625 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
3629 /* Free the local symbol table; we won't need it again. */
3630 freeHashTable(oc->lochash, NULL);
3634 Flush the data & instruction caches.
3635 Because the PPC has split data/instruction caches, we have to
3636 do that whenever we modify code at runtime.
3639 int n = (oc->fileSize + islandSize * oc->n_islands) / 4;
3640 unsigned long *p = (unsigned long*)oc->image;
3643 __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
3647 __asm__ volatile ("sync\n\tisync");
3653 * The Mach-O object format uses leading underscores. But not everywhere.
3654 * There is a small number of runtime support functions defined in
3655 * libcc_dynamic.a whose name does not have a leading underscore.
3656 * As a consequence, we can't get their address from C code.
3657 * We have to use inline assembler just to take the address of a function.
3661 static void machoInitSymbolsWithoutUnderscore()
3667 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3668 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3670 RTS_MACHO_NOUNDERLINE_SYMBOLS