1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.130 2003/09/21 22:20:54 wolfgang Exp $
4 * (c) The GHC Team, 2000-2003
8 * ---------------------------------------------------------------------------*/
11 #include "PosixSource.h"
18 #include "LinkerInternals.h"
20 #include "StoragePriv.h"
23 #ifdef HAVE_SYS_TYPES_H
24 #include <sys/types.h>
30 #ifdef HAVE_SYS_STAT_H
34 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
35 #include <HaskellSupport/dlfcn.h>
36 #elif defined(HAVE_DLFCN_H)
40 #if defined(cygwin32_TARGET_OS)
45 #ifdef HAVE_SYS_TIME_H
49 #include <sys/fcntl.h>
50 #include <sys/termios.h>
51 #include <sys/utime.h>
52 #include <sys/utsname.h>
56 #if defined(ia64_TARGET_ARCH)
62 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
63 # define OBJFORMAT_ELF
64 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
65 # define OBJFORMAT_PEi386
68 #elif defined(darwin_TARGET_OS)
69 # include <mach-o/ppc/reloc.h>
70 # define OBJFORMAT_MACHO
71 # include <mach-o/loader.h>
72 # include <mach-o/nlist.h>
73 # include <mach-o/reloc.h>
74 # include <mach-o/dyld.h>
77 /* Hash table mapping symbol names to Symbol */
78 static /*Str*/HashTable *symhash;
80 /* List of currently loaded objects */
81 ObjectCode *objects = NULL; /* initially empty */
83 #if defined(OBJFORMAT_ELF)
84 static int ocVerifyImage_ELF ( ObjectCode* oc );
85 static int ocGetNames_ELF ( ObjectCode* oc );
86 static int ocResolve_ELF ( ObjectCode* oc );
87 #elif defined(OBJFORMAT_PEi386)
88 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
89 static int ocGetNames_PEi386 ( ObjectCode* oc );
90 static int ocResolve_PEi386 ( ObjectCode* oc );
91 #elif defined(OBJFORMAT_MACHO)
92 static int ocVerifyImage_MachO ( ObjectCode* oc );
93 static int ocGetNames_MachO ( ObjectCode* oc );
94 static int ocResolve_MachO ( ObjectCode* oc );
96 static void machoInitSymbolsWithoutUnderscore( void );
99 /* -----------------------------------------------------------------------------
100 * Built-in symbols from the RTS
103 typedef struct _RtsSymbolVal {
110 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
112 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
113 SymX(makeStableNamezh_fast) \
114 SymX(finalizzeWeakzh_fast)
116 /* These are not available in GUM!!! -- HWL */
117 #define Maybe_ForeignObj
118 #define Maybe_Stable_Names
121 #if !defined (mingw32_TARGET_OS)
122 #define RTS_POSIX_ONLY_SYMBOLS \
123 SymX(stg_sig_install) \
127 #if defined (cygwin32_TARGET_OS)
128 #define RTS_MINGW_ONLY_SYMBOLS /**/
129 /* Don't have the ability to read import libs / archives, so
130 * we have to stupidly list a lot of what libcygwin.a
133 #define RTS_CYGWIN_ONLY_SYMBOLS \
211 #elif !defined(mingw32_TARGET_OS)
212 #define RTS_MINGW_ONLY_SYMBOLS /**/
213 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
214 #else /* defined(mingw32_TARGET_OS) */
215 #define RTS_POSIX_ONLY_SYMBOLS /**/
216 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
218 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
220 #define RTS_MINGW_EXTRA_SYMS \
221 Sym(_imp____mb_cur_max) \
224 #define RTS_MINGW_EXTRA_SYMS
227 /* These are statically linked from the mingw libraries into the ghc
228 executable, so we have to employ this hack. */
229 #define RTS_MINGW_ONLY_SYMBOLS \
230 SymX(asyncReadzh_fast) \
231 SymX(asyncWritezh_fast) \
243 SymX(getservbyname) \
244 SymX(getservbyport) \
245 SymX(getprotobynumber) \
246 SymX(getprotobyname) \
247 SymX(gethostbyname) \
248 SymX(gethostbyaddr) \
283 Sym(_imp___timezone) \
291 RTS_MINGW_EXTRA_SYMS \
296 # define MAIN_CAP_SYM SymX(MainCapability)
298 # define MAIN_CAP_SYM
301 #define RTS_SYMBOLS \
305 SymX(stg_enter_info) \
306 SymX(stg_enter_ret) \
307 SymX(stg_gc_void_info) \
308 SymX(__stg_gc_enter_1) \
309 SymX(stg_gc_noregs) \
310 SymX(stg_gc_unpt_r1_info) \
311 SymX(stg_gc_unpt_r1) \
312 SymX(stg_gc_unbx_r1_info) \
313 SymX(stg_gc_unbx_r1) \
314 SymX(stg_gc_f1_info) \
316 SymX(stg_gc_d1_info) \
318 SymX(stg_gc_l1_info) \
321 SymX(stg_gc_fun_info) \
322 SymX(stg_gc_fun_ret) \
324 SymX(stg_gc_gen_info) \
325 SymX(stg_gc_gen_hp) \
327 SymX(stg_gen_yield) \
328 SymX(stg_yield_noregs) \
329 SymX(stg_yield_to_interpreter) \
330 SymX(stg_gen_block) \
331 SymX(stg_block_noregs) \
333 SymX(stg_block_takemvar) \
334 SymX(stg_block_putmvar) \
335 SymX(stg_seq_frame_info) \
338 SymX(MallocFailHook) \
340 SymX(OutOfHeapHook) \
341 SymX(PatErrorHdrHook) \
342 SymX(PostTraceHook) \
344 SymX(StackOverflowHook) \
345 SymX(__encodeDouble) \
346 SymX(__encodeFloat) \
349 SymX(__gmpz_cmp_si) \
350 SymX(__gmpz_cmp_ui) \
351 SymX(__gmpz_get_si) \
352 SymX(__gmpz_get_ui) \
353 SymX(__int_encodeDouble) \
354 SymX(__int_encodeFloat) \
355 SymX(andIntegerzh_fast) \
356 SymX(blockAsyncExceptionszh_fast) \
359 SymX(complementIntegerzh_fast) \
360 SymX(cmpIntegerzh_fast) \
361 SymX(cmpIntegerIntzh_fast) \
362 SymX(createAdjustor) \
363 SymX(decodeDoublezh_fast) \
364 SymX(decodeFloatzh_fast) \
367 SymX(deRefWeakzh_fast) \
368 SymX(deRefStablePtrzh_fast) \
369 SymX(divExactIntegerzh_fast) \
370 SymX(divModIntegerzh_fast) \
372 SymX(forkProcesszh_fast) \
373 SymX(freeHaskellFunctionPtr) \
374 SymX(freeStablePtr) \
375 SymX(gcdIntegerzh_fast) \
376 SymX(gcdIntegerIntzh_fast) \
377 SymX(gcdIntzh_fast) \
381 SymX(int2Integerzh_fast) \
382 SymX(integer2Intzh_fast) \
383 SymX(integer2Wordzh_fast) \
384 SymX(isCurrentThreadBoundzh_fast) \
385 SymX(isDoubleDenormalized) \
386 SymX(isDoubleInfinite) \
388 SymX(isDoubleNegativeZero) \
389 SymX(isEmptyMVarzh_fast) \
390 SymX(isFloatDenormalized) \
391 SymX(isFloatInfinite) \
393 SymX(isFloatNegativeZero) \
394 SymX(killThreadzh_fast) \
395 SymX(makeStablePtrzh_fast) \
396 SymX(minusIntegerzh_fast) \
397 SymX(mkApUpd0zh_fast) \
398 SymX(myThreadIdzh_fast) \
399 SymX(labelThreadzh_fast) \
400 SymX(newArrayzh_fast) \
401 SymX(newBCOzh_fast) \
402 SymX(newByteArrayzh_fast) \
403 SymX_redirect(newCAF, newDynCAF) \
404 SymX(newMVarzh_fast) \
405 SymX(newMutVarzh_fast) \
406 SymX(atomicModifyMutVarzh_fast) \
407 SymX(newPinnedByteArrayzh_fast) \
408 SymX(orIntegerzh_fast) \
410 SymX(plusIntegerzh_fast) \
413 SymX(putMVarzh_fast) \
414 SymX(quotIntegerzh_fast) \
415 SymX(quotRemIntegerzh_fast) \
417 SymX(raiseIOzh_fast) \
418 SymX(remIntegerzh_fast) \
419 SymX(resetNonBlockingFd) \
422 SymX(rts_checkSchedStatus) \
425 SymX(rts_evalLazyIO) \
426 SymX(rts_evalStableIO) \
430 SymX(rts_getDouble) \
435 SymX(rts_getFunPtr) \
436 SymX(rts_getStablePtr) \
437 SymX(rts_getThreadId) \
439 SymX(rts_getWord32) \
452 SymX(rts_mkStablePtr) \
460 SymX(rtsSupportsBoundThreads) \
463 SymX(startupHaskell) \
464 SymX(shutdownHaskell) \
465 SymX(shutdownHaskellAndExit) \
466 SymX(stable_ptr_table) \
467 SymX(stackOverflow) \
468 SymX(stg_CAF_BLACKHOLE_info) \
469 SymX(stg_BLACKHOLE_BQ_info) \
470 SymX(awakenBlockedQueue) \
471 SymX(stg_CHARLIKE_closure) \
472 SymX(stg_EMPTY_MVAR_info) \
473 SymX(stg_IND_STATIC_info) \
474 SymX(stg_INTLIKE_closure) \
475 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
476 SymX(stg_WEAK_info) \
477 SymX(stg_ap_v_info) \
478 SymX(stg_ap_f_info) \
479 SymX(stg_ap_d_info) \
480 SymX(stg_ap_l_info) \
481 SymX(stg_ap_n_info) \
482 SymX(stg_ap_p_info) \
483 SymX(stg_ap_pv_info) \
484 SymX(stg_ap_pp_info) \
485 SymX(stg_ap_ppv_info) \
486 SymX(stg_ap_ppp_info) \
487 SymX(stg_ap_pppp_info) \
488 SymX(stg_ap_ppppp_info) \
489 SymX(stg_ap_pppppp_info) \
490 SymX(stg_ap_ppppppp_info) \
498 SymX(stg_ap_pv_ret) \
499 SymX(stg_ap_pp_ret) \
500 SymX(stg_ap_ppv_ret) \
501 SymX(stg_ap_ppp_ret) \
502 SymX(stg_ap_pppp_ret) \
503 SymX(stg_ap_ppppp_ret) \
504 SymX(stg_ap_pppppp_ret) \
505 SymX(stg_ap_ppppppp_ret) \
506 SymX(stg_ap_1_upd_info) \
507 SymX(stg_ap_2_upd_info) \
508 SymX(stg_ap_3_upd_info) \
509 SymX(stg_ap_4_upd_info) \
510 SymX(stg_ap_5_upd_info) \
511 SymX(stg_ap_6_upd_info) \
512 SymX(stg_ap_7_upd_info) \
513 SymX(stg_ap_8_upd_info) \
515 SymX(stg_sel_0_upd_info) \
516 SymX(stg_sel_10_upd_info) \
517 SymX(stg_sel_11_upd_info) \
518 SymX(stg_sel_12_upd_info) \
519 SymX(stg_sel_13_upd_info) \
520 SymX(stg_sel_14_upd_info) \
521 SymX(stg_sel_15_upd_info) \
522 SymX(stg_sel_1_upd_info) \
523 SymX(stg_sel_2_upd_info) \
524 SymX(stg_sel_3_upd_info) \
525 SymX(stg_sel_4_upd_info) \
526 SymX(stg_sel_5_upd_info) \
527 SymX(stg_sel_6_upd_info) \
528 SymX(stg_sel_7_upd_info) \
529 SymX(stg_sel_8_upd_info) \
530 SymX(stg_sel_9_upd_info) \
531 SymX(stg_upd_frame_info) \
532 SymX(suspendThread) \
533 SymX(takeMVarzh_fast) \
534 SymX(timesIntegerzh_fast) \
535 SymX(tryPutMVarzh_fast) \
536 SymX(tryTakeMVarzh_fast) \
537 SymX(unblockAsyncExceptionszh_fast) \
538 SymX(unsafeThawArrayzh_fast) \
539 SymX(waitReadzh_fast) \
540 SymX(waitWritezh_fast) \
541 SymX(word2Integerzh_fast) \
542 SymX(xorIntegerzh_fast) \
545 #ifdef SUPPORT_LONG_LONGS
546 #define RTS_LONG_LONG_SYMS \
547 SymX(int64ToIntegerzh_fast) \
548 SymX(word64ToIntegerzh_fast)
550 #define RTS_LONG_LONG_SYMS /* nothing */
553 // 64-bit support functions in libgcc.a
554 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
555 #define RTS_LIBGCC_SYMBOLS \
564 #elif defined(ia64_TARGET_ARCH)
565 #define RTS_LIBGCC_SYMBOLS \
573 #define RTS_LIBGCC_SYMBOLS
576 #ifdef darwin_TARGET_OS
577 // Symbols that don't have a leading underscore
578 // on Mac OS X. They have to receive special treatment,
579 // see machoInitSymbolsWithoutUnderscore()
580 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
585 /* entirely bogus claims about types of these symbols */
586 #define Sym(vvv) extern void vvv(void);
587 #define SymX(vvv) /**/
588 #define SymX_redirect(vvv,xxx) /**/
591 RTS_POSIX_ONLY_SYMBOLS
592 RTS_MINGW_ONLY_SYMBOLS
593 RTS_CYGWIN_ONLY_SYMBOLS
599 #ifdef LEADING_UNDERSCORE
600 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
602 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
605 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
607 #define SymX(vvv) Sym(vvv)
609 // SymX_redirect allows us to redirect references to one symbol to
610 // another symbol. See newCAF/newDynCAF for an example.
611 #define SymX_redirect(vvv,xxx) \
612 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
615 static RtsSymbolVal rtsSyms[] = {
618 RTS_POSIX_ONLY_SYMBOLS
619 RTS_MINGW_ONLY_SYMBOLS
620 RTS_CYGWIN_ONLY_SYMBOLS
622 { 0, 0 } /* sentinel */
625 /* -----------------------------------------------------------------------------
626 * Insert symbols into hash tables, checking for duplicates.
628 static void ghciInsertStrHashTable ( char* obj_name,
634 if (lookupHashTable(table, (StgWord)key) == NULL)
636 insertStrHashTable(table, (StgWord)key, data);
641 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
643 "whilst processing object file\n"
645 "This could be caused by:\n"
646 " * Loading two different object files which export the same symbol\n"
647 " * Specifying the same object file twice on the GHCi command line\n"
648 " * An incorrect `package.conf' entry, causing some object to be\n"
650 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
659 /* -----------------------------------------------------------------------------
660 * initialize the object linker
664 static int linker_init_done = 0 ;
666 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
667 static void *dl_prog_handle;
675 /* Make initLinker idempotent, so we can call it
676 before evey relevant operation; that means we
677 don't need to initialise the linker separately */
678 if (linker_init_done == 1) { return; } else {
679 linker_init_done = 1;
682 symhash = allocStrHashTable();
684 /* populate the symbol table with stuff from the RTS */
685 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
686 ghciInsertStrHashTable("(GHCi built-in symbols)",
687 symhash, sym->lbl, sym->addr);
689 # if defined(OBJFORMAT_MACHO)
690 machoInitSymbolsWithoutUnderscore();
693 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
694 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
698 /* -----------------------------------------------------------------------------
699 * Loading DLL or .so dynamic libraries
700 * -----------------------------------------------------------------------------
702 * Add a DLL from which symbols may be found. In the ELF case, just
703 * do RTLD_GLOBAL-style add, so no further messing around needs to
704 * happen in order that symbols in the loaded .so are findable --
705 * lookupSymbol() will subsequently see them by dlsym on the program's
706 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
708 * In the PEi386 case, open the DLLs and put handles to them in a
709 * linked list. When looking for a symbol, try all handles in the
710 * list. This means that we need to load even DLLs that are guaranteed
711 * to be in the ghc.exe image already, just so we can get a handle
712 * to give to loadSymbol, so that we can find the symbols. For such
713 * libraries, the LoadLibrary call should be a no-op except for returning
718 #if defined(OBJFORMAT_PEi386)
719 /* A record for storing handles into DLLs. */
724 struct _OpenedDLL* next;
729 /* A list thereof. */
730 static OpenedDLL* opened_dlls = NULL;
734 addDLL( char *dll_name )
736 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
737 /* ------------------- ELF DLL loader ------------------- */
743 #if !defined(openbsd_TARGET_OS)
744 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
746 hdl= dlopen(dll_name, RTLD_LAZY);
749 /* dlopen failed; return a ptr to the error msg. */
751 if (errmsg == NULL) errmsg = "addDLL: unknown error";
758 # elif defined(OBJFORMAT_PEi386)
759 /* ------------------- Win32 DLL loader ------------------- */
767 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
769 /* See if we've already got it, and ignore if so. */
770 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
771 if (0 == strcmp(o_dll->name, dll_name))
775 /* The file name has no suffix (yet) so that we can try
776 both foo.dll and foo.drv
778 The documentation for LoadLibrary says:
779 If no file name extension is specified in the lpFileName
780 parameter, the default library extension .dll is
781 appended. However, the file name string can include a trailing
782 point character (.) to indicate that the module name has no
785 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
786 sprintf(buf, "%s.DLL", dll_name);
787 instance = LoadLibrary(buf);
788 if (instance == NULL) {
789 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
790 instance = LoadLibrary(buf);
791 if (instance == NULL) {
794 /* LoadLibrary failed; return a ptr to the error msg. */
795 return "addDLL: unknown error";
800 /* Add this DLL to the list of DLLs in which to search for symbols. */
801 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
802 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
803 strcpy(o_dll->name, dll_name);
804 o_dll->instance = instance;
805 o_dll->next = opened_dlls;
810 barf("addDLL: not implemented on this platform");
814 /* -----------------------------------------------------------------------------
815 * lookup a symbol in the hash table
818 lookupSymbol( char *lbl )
822 ASSERT(symhash != NULL);
823 val = lookupStrHashTable(symhash, lbl);
826 # if defined(OBJFORMAT_ELF)
827 return dlsym(dl_prog_handle, lbl);
828 # elif defined(OBJFORMAT_MACHO)
829 if(NSIsSymbolNameDefined(lbl)) {
830 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
831 return NSAddressOfSymbol(symbol);
835 # elif defined(OBJFORMAT_PEi386)
838 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
839 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
841 /* HACK: if the name has an initial underscore, try stripping
842 it off & look that up first. I've yet to verify whether there's
843 a Rule that governs whether an initial '_' *should always* be
844 stripped off when mapping from import lib name to the DLL name.
846 sym = GetProcAddress(o_dll->instance, (lbl+1));
848 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
852 sym = GetProcAddress(o_dll->instance, lbl);
854 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
869 __attribute((unused))
871 lookupLocalSymbol( ObjectCode* oc, char *lbl )
875 val = lookupStrHashTable(oc->lochash, lbl);
885 /* -----------------------------------------------------------------------------
886 * Debugging aid: look in GHCi's object symbol tables for symbols
887 * within DELTA bytes of the specified address, and show their names.
890 void ghci_enquire ( char* addr );
892 void ghci_enquire ( char* addr )
897 const int DELTA = 64;
902 for (oc = objects; oc; oc = oc->next) {
903 for (i = 0; i < oc->n_symbols; i++) {
904 sym = oc->symbols[i];
905 if (sym == NULL) continue;
906 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
908 if (oc->lochash != NULL) {
909 a = lookupStrHashTable(oc->lochash, sym);
912 a = lookupStrHashTable(symhash, sym);
915 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
917 else if (addr-DELTA <= a && a <= addr+DELTA) {
918 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
925 #ifdef ia64_TARGET_ARCH
926 static unsigned int PLTSize(void);
929 /* -----------------------------------------------------------------------------
930 * Load an obj (populate the global symbol table, but don't resolve yet)
932 * Returns: 1 if ok, 0 on error.
935 loadObj( char *path )
949 /* fprintf(stderr, "loadObj %s\n", path ); */
951 /* Check that we haven't already loaded this object. Don't give up
952 at this stage; ocGetNames_* will barf later. */
956 for (o = objects; o; o = o->next) {
957 if (0 == strcmp(o->fileName, path))
963 "GHCi runtime linker: warning: looks like you're trying to load the\n"
964 "same object file twice:\n"
966 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
972 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
974 # if defined(OBJFORMAT_ELF)
975 oc->formatName = "ELF";
976 # elif defined(OBJFORMAT_PEi386)
977 oc->formatName = "PEi386";
978 # elif defined(OBJFORMAT_MACHO)
979 oc->formatName = "Mach-O";
982 barf("loadObj: not implemented on this platform");
986 if (r == -1) { return 0; }
988 /* sigh, strdup() isn't a POSIX function, so do it the long way */
989 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
990 strcpy(oc->fileName, path);
992 oc->fileSize = st.st_size;
995 oc->lochash = allocStrHashTable();
996 oc->proddables = NULL;
998 /* chain it onto the list of objects */
1003 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1005 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1007 fd = open(path, O_RDONLY);
1009 barf("loadObj: can't open `%s'", path);
1011 pagesize = getpagesize();
1013 #ifdef ia64_TARGET_ARCH
1014 /* The PLT needs to be right before the object */
1015 n = ROUND_UP(PLTSize(), pagesize);
1016 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1017 if (oc->plt == MAP_FAILED)
1018 barf("loadObj: can't allocate PLT");
1021 map_addr = oc->plt + n;
1024 n = ROUND_UP(oc->fileSize, pagesize);
1025 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1026 if (oc->image == MAP_FAILED)
1027 barf("loadObj: can't map `%s'", path);
1031 #else /* !USE_MMAP */
1033 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1035 /* load the image into memory */
1036 f = fopen(path, "rb");
1038 barf("loadObj: can't read `%s'", path);
1040 n = fread ( oc->image, 1, oc->fileSize, f );
1041 if (n != oc->fileSize)
1042 barf("loadObj: error whilst reading `%s'", path);
1046 #endif /* USE_MMAP */
1048 /* verify the in-memory image */
1049 # if defined(OBJFORMAT_ELF)
1050 r = ocVerifyImage_ELF ( oc );
1051 # elif defined(OBJFORMAT_PEi386)
1052 r = ocVerifyImage_PEi386 ( oc );
1053 # elif defined(OBJFORMAT_MACHO)
1054 r = ocVerifyImage_MachO ( oc );
1056 barf("loadObj: no verify method");
1058 if (!r) { return r; }
1060 /* build the symbol list for this image */
1061 # if defined(OBJFORMAT_ELF)
1062 r = ocGetNames_ELF ( oc );
1063 # elif defined(OBJFORMAT_PEi386)
1064 r = ocGetNames_PEi386 ( oc );
1065 # elif defined(OBJFORMAT_MACHO)
1066 r = ocGetNames_MachO ( oc );
1068 barf("loadObj: no getNames method");
1070 if (!r) { return r; }
1072 /* loaded, but not resolved yet */
1073 oc->status = OBJECT_LOADED;
1078 /* -----------------------------------------------------------------------------
1079 * resolve all the currently unlinked objects in memory
1081 * Returns: 1 if ok, 0 on error.
1091 for (oc = objects; oc; oc = oc->next) {
1092 if (oc->status != OBJECT_RESOLVED) {
1093 # if defined(OBJFORMAT_ELF)
1094 r = ocResolve_ELF ( oc );
1095 # elif defined(OBJFORMAT_PEi386)
1096 r = ocResolve_PEi386 ( oc );
1097 # elif defined(OBJFORMAT_MACHO)
1098 r = ocResolve_MachO ( oc );
1100 barf("resolveObjs: not implemented on this platform");
1102 if (!r) { return r; }
1103 oc->status = OBJECT_RESOLVED;
1109 /* -----------------------------------------------------------------------------
1110 * delete an object from the pool
1113 unloadObj( char *path )
1115 ObjectCode *oc, *prev;
1117 ASSERT(symhash != NULL);
1118 ASSERT(objects != NULL);
1123 for (oc = objects; oc; prev = oc, oc = oc->next) {
1124 if (!strcmp(oc->fileName,path)) {
1126 /* Remove all the mappings for the symbols within this
1131 for (i = 0; i < oc->n_symbols; i++) {
1132 if (oc->symbols[i] != NULL) {
1133 removeStrHashTable(symhash, oc->symbols[i], NULL);
1141 prev->next = oc->next;
1144 /* We're going to leave this in place, in case there are
1145 any pointers from the heap into it: */
1146 /* stgFree(oc->image); */
1147 stgFree(oc->fileName);
1148 stgFree(oc->symbols);
1149 stgFree(oc->sections);
1150 /* The local hash table should have been freed at the end
1151 of the ocResolve_ call on it. */
1152 ASSERT(oc->lochash == NULL);
1158 belch("unloadObj: can't find `%s' to unload", path);
1162 /* -----------------------------------------------------------------------------
1163 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1164 * which may be prodded during relocation, and abort if we try and write
1165 * outside any of these.
1167 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1170 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1171 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1175 pb->next = oc->proddables;
1176 oc->proddables = pb;
1179 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1182 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1183 char* s = (char*)(pb->start);
1184 char* e = s + pb->size - 1;
1185 char* a = (char*)addr;
1186 /* Assumes that the biggest fixup involves a 4-byte write. This
1187 probably needs to be changed to 8 (ie, +7) on 64-bit
1189 if (a >= s && (a+3) <= e) return;
1191 barf("checkProddableBlock: invalid fixup in runtime linker");
1194 /* -----------------------------------------------------------------------------
1195 * Section management.
1197 static void addSection ( ObjectCode* oc, SectionKind kind,
1198 void* start, void* end )
1200 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1204 s->next = oc->sections;
1207 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1208 start, ((char*)end)-1, end - start + 1, kind );
1214 /* --------------------------------------------------------------------------
1215 * PEi386 specifics (Win32 targets)
1216 * ------------------------------------------------------------------------*/
1218 /* The information for this linker comes from
1219 Microsoft Portable Executable
1220 and Common Object File Format Specification
1221 revision 5.1 January 1998
1222 which SimonM says comes from the MS Developer Network CDs.
1224 It can be found there (on older CDs), but can also be found
1227 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1229 (this is Rev 6.0 from February 1999).
1231 Things move, so if that fails, try searching for it via
1233 http://www.google.com/search?q=PE+COFF+specification
1235 The ultimate reference for the PE format is the Winnt.h
1236 header file that comes with the Platform SDKs; as always,
1237 implementations will drift wrt their documentation.
1239 A good background article on the PE format is Matt Pietrek's
1240 March 1994 article in Microsoft System Journal (MSJ)
1241 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1242 Win32 Portable Executable File Format." The info in there
1243 has recently been updated in a two part article in
1244 MSDN magazine, issues Feb and March 2002,
1245 "Inside Windows: An In-Depth Look into the Win32 Portable
1246 Executable File Format"
1248 John Levine's book "Linkers and Loaders" contains useful
1253 #if defined(OBJFORMAT_PEi386)
1257 typedef unsigned char UChar;
1258 typedef unsigned short UInt16;
1259 typedef unsigned int UInt32;
1266 UInt16 NumberOfSections;
1267 UInt32 TimeDateStamp;
1268 UInt32 PointerToSymbolTable;
1269 UInt32 NumberOfSymbols;
1270 UInt16 SizeOfOptionalHeader;
1271 UInt16 Characteristics;
1275 #define sizeof_COFF_header 20
1282 UInt32 VirtualAddress;
1283 UInt32 SizeOfRawData;
1284 UInt32 PointerToRawData;
1285 UInt32 PointerToRelocations;
1286 UInt32 PointerToLinenumbers;
1287 UInt16 NumberOfRelocations;
1288 UInt16 NumberOfLineNumbers;
1289 UInt32 Characteristics;
1293 #define sizeof_COFF_section 40
1300 UInt16 SectionNumber;
1303 UChar NumberOfAuxSymbols;
1307 #define sizeof_COFF_symbol 18
1312 UInt32 VirtualAddress;
1313 UInt32 SymbolTableIndex;
1318 #define sizeof_COFF_reloc 10
1321 /* From PE spec doc, section 3.3.2 */
1322 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1323 windows.h -- for the same purpose, but I want to know what I'm
1325 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1326 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1327 #define MYIMAGE_FILE_DLL 0x2000
1328 #define MYIMAGE_FILE_SYSTEM 0x1000
1329 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1330 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1331 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1333 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1334 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1335 #define MYIMAGE_SYM_CLASS_STATIC 3
1336 #define MYIMAGE_SYM_UNDEFINED 0
1338 /* From PE spec doc, section 4.1 */
1339 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1340 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1341 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1343 /* From PE spec doc, section 5.2.1 */
1344 #define MYIMAGE_REL_I386_DIR32 0x0006
1345 #define MYIMAGE_REL_I386_REL32 0x0014
1348 /* We use myindex to calculate array addresses, rather than
1349 simply doing the normal subscript thing. That's because
1350 some of the above structs have sizes which are not
1351 a whole number of words. GCC rounds their sizes up to a
1352 whole number of words, which means that the address calcs
1353 arising from using normal C indexing or pointer arithmetic
1354 are just plain wrong. Sigh.
1357 myindex ( int scale, void* base, int index )
1360 ((UChar*)base) + scale * index;
1365 printName ( UChar* name, UChar* strtab )
1367 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1368 UInt32 strtab_offset = * (UInt32*)(name+4);
1369 fprintf ( stderr, "%s", strtab + strtab_offset );
1372 for (i = 0; i < 8; i++) {
1373 if (name[i] == 0) break;
1374 fprintf ( stderr, "%c", name[i] );
1381 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1383 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1384 UInt32 strtab_offset = * (UInt32*)(name+4);
1385 strncpy ( dst, strtab+strtab_offset, dstSize );
1391 if (name[i] == 0) break;
1401 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1404 /* If the string is longer than 8 bytes, look in the
1405 string table for it -- this will be correctly zero terminated.
1407 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1408 UInt32 strtab_offset = * (UInt32*)(name+4);
1409 return ((UChar*)strtab) + strtab_offset;
1411 /* Otherwise, if shorter than 8 bytes, return the original,
1412 which by defn is correctly terminated.
1414 if (name[7]==0) return name;
1415 /* The annoying case: 8 bytes. Copy into a temporary
1416 (which is never freed ...)
1418 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1420 strncpy(newstr,name,8);
1426 /* Just compares the short names (first 8 chars) */
1427 static COFF_section *
1428 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1432 = (COFF_header*)(oc->image);
1433 COFF_section* sectab
1435 ((UChar*)(oc->image))
1436 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1438 for (i = 0; i < hdr->NumberOfSections; i++) {
1441 COFF_section* section_i
1443 myindex ( sizeof_COFF_section, sectab, i );
1444 n1 = (UChar*) &(section_i->Name);
1446 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1447 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1448 n1[6]==n2[6] && n1[7]==n2[7])
1457 zapTrailingAtSign ( UChar* sym )
1459 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1461 if (sym[0] == 0) return;
1463 while (sym[i] != 0) i++;
1466 while (j > 0 && my_isdigit(sym[j])) j--;
1467 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1473 ocVerifyImage_PEi386 ( ObjectCode* oc )
1478 COFF_section* sectab;
1479 COFF_symbol* symtab;
1481 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1482 hdr = (COFF_header*)(oc->image);
1483 sectab = (COFF_section*) (
1484 ((UChar*)(oc->image))
1485 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1487 symtab = (COFF_symbol*) (
1488 ((UChar*)(oc->image))
1489 + hdr->PointerToSymbolTable
1491 strtab = ((UChar*)symtab)
1492 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1494 if (hdr->Machine != 0x14c) {
1495 belch("Not x86 PEi386");
1498 if (hdr->SizeOfOptionalHeader != 0) {
1499 belch("PEi386 with nonempty optional header");
1502 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1503 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1504 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1505 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1506 belch("Not a PEi386 object file");
1509 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1510 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1511 belch("Invalid PEi386 word size or endiannness: %d",
1512 (int)(hdr->Characteristics));
1515 /* If the string table size is way crazy, this might indicate that
1516 there are more than 64k relocations, despite claims to the
1517 contrary. Hence this test. */
1518 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1520 if ( (*(UInt32*)strtab) > 600000 ) {
1521 /* Note that 600k has no special significance other than being
1522 big enough to handle the almost-2MB-sized lumps that
1523 constitute HSwin32*.o. */
1524 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1529 /* No further verification after this point; only debug printing. */
1531 IF_DEBUG(linker, i=1);
1532 if (i == 0) return 1;
1535 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1537 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1539 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1541 fprintf ( stderr, "\n" );
1543 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1545 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1547 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1549 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1551 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1553 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1555 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1557 /* Print the section table. */
1558 fprintf ( stderr, "\n" );
1559 for (i = 0; i < hdr->NumberOfSections; i++) {
1561 COFF_section* sectab_i
1563 myindex ( sizeof_COFF_section, sectab, i );
1570 printName ( sectab_i->Name, strtab );
1580 sectab_i->VirtualSize,
1581 sectab_i->VirtualAddress,
1582 sectab_i->SizeOfRawData,
1583 sectab_i->PointerToRawData,
1584 sectab_i->NumberOfRelocations,
1585 sectab_i->PointerToRelocations,
1586 sectab_i->PointerToRawData
1588 reltab = (COFF_reloc*) (
1589 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1592 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1593 /* If the relocation field (a short) has overflowed, the
1594 * real count can be found in the first reloc entry.
1596 * See Section 4.1 (last para) of the PE spec (rev6.0).
1598 COFF_reloc* rel = (COFF_reloc*)
1599 myindex ( sizeof_COFF_reloc, reltab, 0 );
1600 noRelocs = rel->VirtualAddress;
1603 noRelocs = sectab_i->NumberOfRelocations;
1607 for (; j < noRelocs; j++) {
1609 COFF_reloc* rel = (COFF_reloc*)
1610 myindex ( sizeof_COFF_reloc, reltab, j );
1612 " type 0x%-4x vaddr 0x%-8x name `",
1614 rel->VirtualAddress );
1615 sym = (COFF_symbol*)
1616 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1617 /* Hmm..mysterious looking offset - what's it for? SOF */
1618 printName ( sym->Name, strtab -10 );
1619 fprintf ( stderr, "'\n" );
1622 fprintf ( stderr, "\n" );
1624 fprintf ( stderr, "\n" );
1625 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1626 fprintf ( stderr, "---START of string table---\n");
1627 for (i = 4; i < *(Int32*)strtab; i++) {
1629 fprintf ( stderr, "\n"); else
1630 fprintf( stderr, "%c", strtab[i] );
1632 fprintf ( stderr, "--- END of string table---\n");
1634 fprintf ( stderr, "\n" );
1637 COFF_symbol* symtab_i;
1638 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1639 symtab_i = (COFF_symbol*)
1640 myindex ( sizeof_COFF_symbol, symtab, i );
1646 printName ( symtab_i->Name, strtab );
1655 (Int32)(symtab_i->SectionNumber),
1656 (UInt32)symtab_i->Type,
1657 (UInt32)symtab_i->StorageClass,
1658 (UInt32)symtab_i->NumberOfAuxSymbols
1660 i += symtab_i->NumberOfAuxSymbols;
1664 fprintf ( stderr, "\n" );
1670 ocGetNames_PEi386 ( ObjectCode* oc )
1673 COFF_section* sectab;
1674 COFF_symbol* symtab;
1681 hdr = (COFF_header*)(oc->image);
1682 sectab = (COFF_section*) (
1683 ((UChar*)(oc->image))
1684 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1686 symtab = (COFF_symbol*) (
1687 ((UChar*)(oc->image))
1688 + hdr->PointerToSymbolTable
1690 strtab = ((UChar*)(oc->image))
1691 + hdr->PointerToSymbolTable
1692 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1694 /* Allocate space for any (local, anonymous) .bss sections. */
1696 for (i = 0; i < hdr->NumberOfSections; i++) {
1698 COFF_section* sectab_i
1700 myindex ( sizeof_COFF_section, sectab, i );
1701 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1702 if (sectab_i->VirtualSize == 0) continue;
1703 /* This is a non-empty .bss section. Allocate zeroed space for
1704 it, and set its PointerToRawData field such that oc->image +
1705 PointerToRawData == addr_of_zeroed_space. */
1706 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1707 "ocGetNames_PEi386(anonymous bss)");
1708 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1709 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1710 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1713 /* Copy section information into the ObjectCode. */
1715 for (i = 0; i < hdr->NumberOfSections; i++) {
1721 = SECTIONKIND_OTHER;
1722 COFF_section* sectab_i
1724 myindex ( sizeof_COFF_section, sectab, i );
1725 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1728 /* I'm sure this is the Right Way to do it. However, the
1729 alternative of testing the sectab_i->Name field seems to
1730 work ok with Cygwin.
1732 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1733 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1734 kind = SECTIONKIND_CODE_OR_RODATA;
1737 if (0==strcmp(".text",sectab_i->Name) ||
1738 0==strcmp(".rodata",sectab_i->Name))
1739 kind = SECTIONKIND_CODE_OR_RODATA;
1740 if (0==strcmp(".data",sectab_i->Name) ||
1741 0==strcmp(".bss",sectab_i->Name))
1742 kind = SECTIONKIND_RWDATA;
1744 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1745 sz = sectab_i->SizeOfRawData;
1746 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1748 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1749 end = start + sz - 1;
1751 if (kind == SECTIONKIND_OTHER
1752 /* Ignore sections called which contain stabs debugging
1754 && 0 != strcmp(".stab", sectab_i->Name)
1755 && 0 != strcmp(".stabstr", sectab_i->Name)
1757 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1761 if (kind != SECTIONKIND_OTHER && end >= start) {
1762 addSection(oc, kind, start, end);
1763 addProddableBlock(oc, start, end - start + 1);
1767 /* Copy exported symbols into the ObjectCode. */
1769 oc->n_symbols = hdr->NumberOfSymbols;
1770 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1771 "ocGetNames_PEi386(oc->symbols)");
1772 /* Call me paranoid; I don't care. */
1773 for (i = 0; i < oc->n_symbols; i++)
1774 oc->symbols[i] = NULL;
1778 COFF_symbol* symtab_i;
1779 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1780 symtab_i = (COFF_symbol*)
1781 myindex ( sizeof_COFF_symbol, symtab, i );
1785 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1786 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1787 /* This symbol is global and defined, viz, exported */
1788 /* for MYIMAGE_SYMCLASS_EXTERNAL
1789 && !MYIMAGE_SYM_UNDEFINED,
1790 the address of the symbol is:
1791 address of relevant section + offset in section
1793 COFF_section* sectabent
1794 = (COFF_section*) myindex ( sizeof_COFF_section,
1796 symtab_i->SectionNumber-1 );
1797 addr = ((UChar*)(oc->image))
1798 + (sectabent->PointerToRawData
1802 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1803 && symtab_i->Value > 0) {
1804 /* This symbol isn't in any section at all, ie, global bss.
1805 Allocate zeroed space for it. */
1806 addr = stgCallocBytes(1, symtab_i->Value,
1807 "ocGetNames_PEi386(non-anonymous bss)");
1808 addSection(oc, SECTIONKIND_RWDATA, addr,
1809 ((UChar*)addr) + symtab_i->Value - 1);
1810 addProddableBlock(oc, addr, symtab_i->Value);
1811 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1814 if (addr != NULL ) {
1815 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1816 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1817 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1818 ASSERT(i >= 0 && i < oc->n_symbols);
1819 /* cstring_from_COFF_symbol_name always succeeds. */
1820 oc->symbols[i] = sname;
1821 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1825 "IGNORING symbol %d\n"
1829 printName ( symtab_i->Name, strtab );
1838 (Int32)(symtab_i->SectionNumber),
1839 (UInt32)symtab_i->Type,
1840 (UInt32)symtab_i->StorageClass,
1841 (UInt32)symtab_i->NumberOfAuxSymbols
1846 i += symtab_i->NumberOfAuxSymbols;
1855 ocResolve_PEi386 ( ObjectCode* oc )
1858 COFF_section* sectab;
1859 COFF_symbol* symtab;
1869 /* ToDo: should be variable-sized? But is at least safe in the
1870 sense of buffer-overrun-proof. */
1872 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1874 hdr = (COFF_header*)(oc->image);
1875 sectab = (COFF_section*) (
1876 ((UChar*)(oc->image))
1877 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1879 symtab = (COFF_symbol*) (
1880 ((UChar*)(oc->image))
1881 + hdr->PointerToSymbolTable
1883 strtab = ((UChar*)(oc->image))
1884 + hdr->PointerToSymbolTable
1885 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1887 for (i = 0; i < hdr->NumberOfSections; i++) {
1888 COFF_section* sectab_i
1890 myindex ( sizeof_COFF_section, sectab, i );
1893 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1896 /* Ignore sections called which contain stabs debugging
1898 if (0 == strcmp(".stab", sectab_i->Name)
1899 || 0 == strcmp(".stabstr", sectab_i->Name))
1902 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1903 /* If the relocation field (a short) has overflowed, the
1904 * real count can be found in the first reloc entry.
1906 * See Section 4.1 (last para) of the PE spec (rev6.0).
1908 COFF_reloc* rel = (COFF_reloc*)
1909 myindex ( sizeof_COFF_reloc, reltab, 0 );
1910 noRelocs = rel->VirtualAddress;
1911 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1914 noRelocs = sectab_i->NumberOfRelocations;
1919 for (; j < noRelocs; j++) {
1921 COFF_reloc* reltab_j
1923 myindex ( sizeof_COFF_reloc, reltab, j );
1925 /* the location to patch */
1927 ((UChar*)(oc->image))
1928 + (sectab_i->PointerToRawData
1929 + reltab_j->VirtualAddress
1930 - sectab_i->VirtualAddress )
1932 /* the existing contents of pP */
1934 /* the symbol to connect to */
1935 sym = (COFF_symbol*)
1936 myindex ( sizeof_COFF_symbol,
1937 symtab, reltab_j->SymbolTableIndex );
1940 "reloc sec %2d num %3d: type 0x%-4x "
1941 "vaddr 0x%-8x name `",
1943 (UInt32)reltab_j->Type,
1944 reltab_j->VirtualAddress );
1945 printName ( sym->Name, strtab );
1946 fprintf ( stderr, "'\n" ));
1948 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1949 COFF_section* section_sym
1950 = findPEi386SectionCalled ( oc, sym->Name );
1952 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1955 S = ((UInt32)(oc->image))
1956 + (section_sym->PointerToRawData
1959 copyName ( sym->Name, strtab, symbol, 1000-1 );
1960 (void*)S = lookupLocalSymbol( oc, symbol );
1961 if ((void*)S != NULL) goto foundit;
1962 (void*)S = lookupSymbol( symbol );
1963 if ((void*)S != NULL) goto foundit;
1964 zapTrailingAtSign ( symbol );
1965 (void*)S = lookupLocalSymbol( oc, symbol );
1966 if ((void*)S != NULL) goto foundit;
1967 (void*)S = lookupSymbol( symbol );
1968 if ((void*)S != NULL) goto foundit;
1969 /* Newline first because the interactive linker has printed "linking..." */
1970 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1974 checkProddableBlock(oc, pP);
1975 switch (reltab_j->Type) {
1976 case MYIMAGE_REL_I386_DIR32:
1979 case MYIMAGE_REL_I386_REL32:
1980 /* Tricky. We have to insert a displacement at
1981 pP which, when added to the PC for the _next_
1982 insn, gives the address of the target (S).
1983 Problem is to know the address of the next insn
1984 when we only know pP. We assume that this
1985 literal field is always the last in the insn,
1986 so that the address of the next insn is pP+4
1987 -- hence the constant 4.
1988 Also I don't know if A should be added, but so
1989 far it has always been zero.
1992 *pP = S - ((UInt32)pP) - 4;
1995 belch("%s: unhandled PEi386 relocation type %d",
1996 oc->fileName, reltab_j->Type);
2003 IF_DEBUG(linker, belch("completed %s", oc->fileName));
2007 #endif /* defined(OBJFORMAT_PEi386) */
2010 /* --------------------------------------------------------------------------
2012 * ------------------------------------------------------------------------*/
2014 #if defined(OBJFORMAT_ELF)
2019 #if defined(sparc_TARGET_ARCH)
2020 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2021 #elif defined(i386_TARGET_ARCH)
2022 # define ELF_TARGET_386 /* Used inside <elf.h> */
2023 #elif defined(x86_64_TARGET_ARCH)
2024 # define ELF_TARGET_X64_64
2026 #elif defined (ia64_TARGET_ARCH)
2027 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2029 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2030 # define ELF_NEED_GOT /* needs Global Offset Table */
2031 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2034 #if !defined(openbsd_TARGET_OS)
2037 /* openbsd elf has things in different places, with diff names */
2038 #include <elf_abi.h>
2039 #include <machine/reloc.h>
2040 #define R_386_32 RELOC_32
2041 #define R_386_PC32 RELOC_PC32
2045 * Define a set of types which can be used for both ELF32 and ELF64
2049 #define ELFCLASS ELFCLASS64
2050 #define Elf_Addr Elf64_Addr
2051 #define Elf_Word Elf64_Word
2052 #define Elf_Sword Elf64_Sword
2053 #define Elf_Ehdr Elf64_Ehdr
2054 #define Elf_Phdr Elf64_Phdr
2055 #define Elf_Shdr Elf64_Shdr
2056 #define Elf_Sym Elf64_Sym
2057 #define Elf_Rel Elf64_Rel
2058 #define Elf_Rela Elf64_Rela
2059 #define ELF_ST_TYPE ELF64_ST_TYPE
2060 #define ELF_ST_BIND ELF64_ST_BIND
2061 #define ELF_R_TYPE ELF64_R_TYPE
2062 #define ELF_R_SYM ELF64_R_SYM
2064 #define ELFCLASS ELFCLASS32
2065 #define Elf_Addr Elf32_Addr
2066 #define Elf_Word Elf32_Word
2067 #define Elf_Sword Elf32_Sword
2068 #define Elf_Ehdr Elf32_Ehdr
2069 #define Elf_Phdr Elf32_Phdr
2070 #define Elf_Shdr Elf32_Shdr
2071 #define Elf_Sym Elf32_Sym
2072 #define Elf_Rel Elf32_Rel
2073 #define Elf_Rela Elf32_Rela
2075 #define ELF_ST_TYPE ELF32_ST_TYPE
2078 #define ELF_ST_BIND ELF32_ST_BIND
2081 #define ELF_R_TYPE ELF32_R_TYPE
2084 #define ELF_R_SYM ELF32_R_SYM
2090 * Functions to allocate entries in dynamic sections. Currently we simply
2091 * preallocate a large number, and we don't check if a entry for the given
2092 * target already exists (a linear search is too slow). Ideally these
2093 * entries would be associated with symbols.
2096 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2097 #define GOT_SIZE 0x20000
2098 #define FUNCTION_TABLE_SIZE 0x10000
2099 #define PLT_SIZE 0x08000
2102 static Elf_Addr got[GOT_SIZE];
2103 static unsigned int gotIndex;
2104 static Elf_Addr gp_val = (Elf_Addr)got;
2107 allocateGOTEntry(Elf_Addr target)
2111 if (gotIndex >= GOT_SIZE)
2112 barf("Global offset table overflow");
2114 entry = &got[gotIndex++];
2116 return (Elf_Addr)entry;
2120 #ifdef ELF_FUNCTION_DESC
2126 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2127 static unsigned int functionTableIndex;
2130 allocateFunctionDesc(Elf_Addr target)
2132 FunctionDesc *entry;
2134 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2135 barf("Function table overflow");
2137 entry = &functionTable[functionTableIndex++];
2139 entry->gp = (Elf_Addr)gp_val;
2140 return (Elf_Addr)entry;
2144 copyFunctionDesc(Elf_Addr target)
2146 FunctionDesc *olddesc = (FunctionDesc *)target;
2147 FunctionDesc *newdesc;
2149 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2150 newdesc->gp = olddesc->gp;
2151 return (Elf_Addr)newdesc;
2156 #ifdef ia64_TARGET_ARCH
2157 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2158 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2160 static unsigned char plt_code[] =
2162 /* taken from binutils bfd/elfxx-ia64.c */
2163 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2164 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2165 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2166 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2167 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2168 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2171 /* If we can't get to the function descriptor via gp, take a local copy of it */
2172 #define PLT_RELOC(code, target) { \
2173 Elf64_Sxword rel_value = target - gp_val; \
2174 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2175 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2177 ia64_reloc_gprel22((Elf_Addr)code, target); \
2182 unsigned char code[sizeof(plt_code)];
2186 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2188 PLTEntry *plt = (PLTEntry *)oc->plt;
2191 if (oc->pltIndex >= PLT_SIZE)
2192 barf("Procedure table overflow");
2194 entry = &plt[oc->pltIndex++];
2195 memcpy(entry->code, plt_code, sizeof(entry->code));
2196 PLT_RELOC(entry->code, target);
2197 return (Elf_Addr)entry;
2203 return (PLT_SIZE * sizeof(PLTEntry));
2209 * Generic ELF functions
2213 findElfSection ( void* objImage, Elf_Word sh_type )
2215 char* ehdrC = (char*)objImage;
2216 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2217 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2218 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2222 for (i = 0; i < ehdr->e_shnum; i++) {
2223 if (shdr[i].sh_type == sh_type
2224 /* Ignore the section header's string table. */
2225 && i != ehdr->e_shstrndx
2226 /* Ignore string tables named .stabstr, as they contain
2228 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2230 ptr = ehdrC + shdr[i].sh_offset;
2237 #if defined(ia64_TARGET_ARCH)
2239 findElfSegment ( void* objImage, Elf_Addr vaddr )
2241 char* ehdrC = (char*)objImage;
2242 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2243 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2244 Elf_Addr segaddr = 0;
2247 for (i = 0; i < ehdr->e_phnum; i++) {
2248 segaddr = phdr[i].p_vaddr;
2249 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2257 ocVerifyImage_ELF ( ObjectCode* oc )
2261 int i, j, nent, nstrtab, nsymtabs;
2265 char* ehdrC = (char*)(oc->image);
2266 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2268 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2269 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2270 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2271 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2272 belch("%s: not an ELF object", oc->fileName);
2276 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2277 belch("%s: unsupported ELF format", oc->fileName);
2281 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2282 IF_DEBUG(linker,belch( "Is little-endian" ));
2284 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2285 IF_DEBUG(linker,belch( "Is big-endian" ));
2287 belch("%s: unknown endiannness", oc->fileName);
2291 if (ehdr->e_type != ET_REL) {
2292 belch("%s: not a relocatable object (.o) file", oc->fileName);
2295 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2297 IF_DEBUG(linker,belch( "Architecture is " ));
2298 switch (ehdr->e_machine) {
2299 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2300 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2302 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2304 default: IF_DEBUG(linker,belch( "unknown" ));
2305 belch("%s: unknown architecture", oc->fileName);
2309 IF_DEBUG(linker,belch(
2310 "\nSection header table: start %d, n_entries %d, ent_size %d",
2311 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2313 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2315 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2317 if (ehdr->e_shstrndx == SHN_UNDEF) {
2318 belch("%s: no section header string table", oc->fileName);
2321 IF_DEBUG(linker,belch( "Section header string table is section %d",
2323 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2326 for (i = 0; i < ehdr->e_shnum; i++) {
2327 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2328 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2329 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2330 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2331 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2332 ehdrC + shdr[i].sh_offset,
2333 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2335 if (shdr[i].sh_type == SHT_REL) {
2336 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2337 } else if (shdr[i].sh_type == SHT_RELA) {
2338 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2340 IF_DEBUG(linker,fprintf(stderr," "));
2343 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2347 IF_DEBUG(linker,belch( "\nString tables" ));
2350 for (i = 0; i < ehdr->e_shnum; i++) {
2351 if (shdr[i].sh_type == SHT_STRTAB
2352 /* Ignore the section header's string table. */
2353 && i != ehdr->e_shstrndx
2354 /* Ignore string tables named .stabstr, as they contain
2356 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2358 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2359 strtab = ehdrC + shdr[i].sh_offset;
2364 belch("%s: no string tables, or too many", oc->fileName);
2369 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2370 for (i = 0; i < ehdr->e_shnum; i++) {
2371 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2372 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2374 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2375 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2376 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2378 shdr[i].sh_size % sizeof(Elf_Sym)
2380 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2381 belch("%s: non-integral number of symbol table entries", oc->fileName);
2384 for (j = 0; j < nent; j++) {
2385 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2386 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2387 (int)stab[j].st_shndx,
2388 (int)stab[j].st_size,
2389 (char*)stab[j].st_value ));
2391 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2392 switch (ELF_ST_TYPE(stab[j].st_info)) {
2393 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2394 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2395 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2396 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2397 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2398 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2400 IF_DEBUG(linker,fprintf(stderr, " " ));
2402 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2403 switch (ELF_ST_BIND(stab[j].st_info)) {
2404 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2405 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2406 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2407 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2409 IF_DEBUG(linker,fprintf(stderr, " " ));
2411 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2415 if (nsymtabs == 0) {
2416 belch("%s: didn't find any symbol tables", oc->fileName);
2425 ocGetNames_ELF ( ObjectCode* oc )
2430 char* ehdrC = (char*)(oc->image);
2431 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2432 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2433 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2435 ASSERT(symhash != NULL);
2438 belch("%s: no strtab", oc->fileName);
2443 for (i = 0; i < ehdr->e_shnum; i++) {
2444 /* Figure out what kind of section it is. Logic derived from
2445 Figure 1.14 ("Special Sections") of the ELF document
2446 ("Portable Formats Specification, Version 1.1"). */
2447 Elf_Shdr hdr = shdr[i];
2448 SectionKind kind = SECTIONKIND_OTHER;
2451 if (hdr.sh_type == SHT_PROGBITS
2452 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2453 /* .text-style section */
2454 kind = SECTIONKIND_CODE_OR_RODATA;
2457 if (hdr.sh_type == SHT_PROGBITS
2458 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2459 /* .data-style section */
2460 kind = SECTIONKIND_RWDATA;
2463 if (hdr.sh_type == SHT_PROGBITS
2464 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2465 /* .rodata-style section */
2466 kind = SECTIONKIND_CODE_OR_RODATA;
2469 if (hdr.sh_type == SHT_NOBITS
2470 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2471 /* .bss-style section */
2472 kind = SECTIONKIND_RWDATA;
2476 if (is_bss && shdr[i].sh_size > 0) {
2477 /* This is a non-empty .bss section. Allocate zeroed space for
2478 it, and set its .sh_offset field such that
2479 ehdrC + .sh_offset == addr_of_zeroed_space. */
2480 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2481 "ocGetNames_ELF(BSS)");
2482 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2484 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2485 zspace, shdr[i].sh_size);
2489 /* fill in the section info */
2490 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2491 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2492 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2493 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2496 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2498 /* copy stuff into this module's object symbol table */
2499 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2500 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2502 oc->n_symbols = nent;
2503 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2504 "ocGetNames_ELF(oc->symbols)");
2506 for (j = 0; j < nent; j++) {
2508 char isLocal = FALSE; /* avoids uninit-var warning */
2510 char* nm = strtab + stab[j].st_name;
2511 int secno = stab[j].st_shndx;
2513 /* Figure out if we want to add it; if so, set ad to its
2514 address. Otherwise leave ad == NULL. */
2516 if (secno == SHN_COMMON) {
2518 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2520 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2521 stab[j].st_size, nm);
2523 /* Pointless to do addProddableBlock() for this area,
2524 since the linker should never poke around in it. */
2527 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2528 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2530 /* and not an undefined symbol */
2531 && stab[j].st_shndx != SHN_UNDEF
2532 /* and not in a "special section" */
2533 && stab[j].st_shndx < SHN_LORESERVE
2535 /* and it's a not a section or string table or anything silly */
2536 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2537 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2538 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2541 /* Section 0 is the undefined section, hence > and not >=. */
2542 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2544 if (shdr[secno].sh_type == SHT_NOBITS) {
2545 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2546 stab[j].st_size, stab[j].st_value, nm);
2549 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2550 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2553 #ifdef ELF_FUNCTION_DESC
2554 /* dlsym() and the initialisation table both give us function
2555 * descriptors, so to be consistent we store function descriptors
2556 * in the symbol table */
2557 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2558 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2560 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2561 ad, oc->fileName, nm ));
2566 /* And the decision is ... */
2570 oc->symbols[j] = nm;
2573 /* Ignore entirely. */
2575 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2579 IF_DEBUG(linker,belch( "skipping `%s'",
2580 strtab + stab[j].st_name ));
2583 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2584 (int)ELF_ST_BIND(stab[j].st_info),
2585 (int)ELF_ST_TYPE(stab[j].st_info),
2586 (int)stab[j].st_shndx,
2587 strtab + stab[j].st_name
2590 oc->symbols[j] = NULL;
2599 /* Do ELF relocations which lack an explicit addend. All x86-linux
2600 relocations appear to be of this form. */
2602 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2603 Elf_Shdr* shdr, int shnum,
2604 Elf_Sym* stab, char* strtab )
2609 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2610 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2611 int target_shndx = shdr[shnum].sh_info;
2612 int symtab_shndx = shdr[shnum].sh_link;
2614 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2615 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2616 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2617 target_shndx, symtab_shndx ));
2619 for (j = 0; j < nent; j++) {
2620 Elf_Addr offset = rtab[j].r_offset;
2621 Elf_Addr info = rtab[j].r_info;
2623 Elf_Addr P = ((Elf_Addr)targ) + offset;
2624 Elf_Word* pP = (Elf_Word*)P;
2629 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2630 j, (void*)offset, (void*)info ));
2632 IF_DEBUG(linker,belch( " ZERO" ));
2635 Elf_Sym sym = stab[ELF_R_SYM(info)];
2636 /* First see if it is a local symbol. */
2637 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2638 /* Yes, so we can get the address directly from the ELF symbol
2640 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2642 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2643 + stab[ELF_R_SYM(info)].st_value);
2646 /* No, so look up the name in our global table. */
2647 symbol = strtab + sym.st_name;
2648 (void*)S = lookupSymbol( symbol );
2651 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2654 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2657 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2658 (void*)P, (void*)S, (void*)A ));
2659 checkProddableBlock ( oc, pP );
2663 switch (ELF_R_TYPE(info)) {
2664 # ifdef i386_TARGET_ARCH
2665 case R_386_32: *pP = value; break;
2666 case R_386_PC32: *pP = value - P; break;
2669 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2670 oc->fileName, ELF_R_TYPE(info));
2678 /* Do ELF relocations for which explicit addends are supplied.
2679 sparc-solaris relocations appear to be of this form. */
2681 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2682 Elf_Shdr* shdr, int shnum,
2683 Elf_Sym* stab, char* strtab )
2688 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2689 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2690 int target_shndx = shdr[shnum].sh_info;
2691 int symtab_shndx = shdr[shnum].sh_link;
2693 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2694 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2695 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2696 target_shndx, symtab_shndx ));
2698 for (j = 0; j < nent; j++) {
2699 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2700 /* This #ifdef only serves to avoid unused-var warnings. */
2701 Elf_Addr offset = rtab[j].r_offset;
2702 Elf_Addr P = targ + offset;
2704 Elf_Addr info = rtab[j].r_info;
2705 Elf_Addr A = rtab[j].r_addend;
2708 # if defined(sparc_TARGET_ARCH)
2709 Elf_Word* pP = (Elf_Word*)P;
2711 # elif defined(ia64_TARGET_ARCH)
2712 Elf64_Xword *pP = (Elf64_Xword *)P;
2716 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2717 j, (void*)offset, (void*)info,
2720 IF_DEBUG(linker,belch( " ZERO" ));
2723 Elf_Sym sym = stab[ELF_R_SYM(info)];
2724 /* First see if it is a local symbol. */
2725 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2726 /* Yes, so we can get the address directly from the ELF symbol
2728 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2730 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2731 + stab[ELF_R_SYM(info)].st_value);
2732 #ifdef ELF_FUNCTION_DESC
2733 /* Make a function descriptor for this function */
2734 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2735 S = allocateFunctionDesc(S + A);
2740 /* No, so look up the name in our global table. */
2741 symbol = strtab + sym.st_name;
2742 (void*)S = lookupSymbol( symbol );
2744 #ifdef ELF_FUNCTION_DESC
2745 /* If a function, already a function descriptor - we would
2746 have to copy it to add an offset. */
2747 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2748 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2752 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2755 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2758 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2759 (void*)P, (void*)S, (void*)A ));
2760 /* checkProddableBlock ( oc, (void*)P ); */
2764 switch (ELF_R_TYPE(info)) {
2765 # if defined(sparc_TARGET_ARCH)
2766 case R_SPARC_WDISP30:
2767 w1 = *pP & 0xC0000000;
2768 w2 = (Elf_Word)((value - P) >> 2);
2769 ASSERT((w2 & 0xC0000000) == 0);
2774 w1 = *pP & 0xFFC00000;
2775 w2 = (Elf_Word)(value >> 10);
2776 ASSERT((w2 & 0xFFC00000) == 0);
2782 w2 = (Elf_Word)(value & 0x3FF);
2783 ASSERT((w2 & ~0x3FF) == 0);
2787 /* According to the Sun documentation:
2789 This relocation type resembles R_SPARC_32, except it refers to an
2790 unaligned word. That is, the word to be relocated must be treated
2791 as four separate bytes with arbitrary alignment, not as a word
2792 aligned according to the architecture requirements.
2794 (JRS: which means that freeloading on the R_SPARC_32 case
2795 is probably wrong, but hey ...)
2799 w2 = (Elf_Word)value;
2802 # elif defined(ia64_TARGET_ARCH)
2803 case R_IA64_DIR64LSB:
2804 case R_IA64_FPTR64LSB:
2807 case R_IA64_PCREL64LSB:
2810 case R_IA64_SEGREL64LSB:
2811 addr = findElfSegment(ehdrC, value);
2814 case R_IA64_GPREL22:
2815 ia64_reloc_gprel22(P, value);
2817 case R_IA64_LTOFF22:
2818 case R_IA64_LTOFF22X:
2819 case R_IA64_LTOFF_FPTR22:
2820 addr = allocateGOTEntry(value);
2821 ia64_reloc_gprel22(P, addr);
2823 case R_IA64_PCREL21B:
2824 ia64_reloc_pcrel21(P, S, oc);
2827 /* This goes with R_IA64_LTOFF22X and points to the load to
2828 * convert into a move. We don't implement relaxation. */
2832 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2833 oc->fileName, ELF_R_TYPE(info));
2842 ocResolve_ELF ( ObjectCode* oc )
2846 Elf_Sym* stab = NULL;
2847 char* ehdrC = (char*)(oc->image);
2848 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2849 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2850 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2852 /* first find "the" symbol table */
2853 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2855 /* also go find the string table */
2856 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2858 if (stab == NULL || strtab == NULL) {
2859 belch("%s: can't find string or symbol table", oc->fileName);
2863 /* Process the relocation sections. */
2864 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2866 /* Skip sections called ".rel.stab". These appear to contain
2867 relocation entries that, when done, make the stabs debugging
2868 info point at the right places. We ain't interested in all
2870 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2873 if (shdr[shnum].sh_type == SHT_REL ) {
2874 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2875 shnum, stab, strtab );
2879 if (shdr[shnum].sh_type == SHT_RELA) {
2880 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2881 shnum, stab, strtab );
2886 /* Free the local symbol table; we won't need it again. */
2887 freeHashTable(oc->lochash, NULL);
2895 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2896 * at the front. The following utility functions pack and unpack instructions, and
2897 * take care of the most common relocations.
2900 #ifdef ia64_TARGET_ARCH
2903 ia64_extract_instruction(Elf64_Xword *target)
2906 int slot = (Elf_Addr)target & 3;
2907 (Elf_Addr)target &= ~3;
2915 return ((w1 >> 5) & 0x1ffffffffff);
2917 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2921 barf("ia64_extract_instruction: invalid slot %p", target);
2926 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2928 int slot = (Elf_Addr)target & 3;
2929 (Elf_Addr)target &= ~3;
2934 *target |= value << 5;
2937 *target |= value << 46;
2938 *(target+1) |= value >> 18;
2941 *(target+1) |= value << 23;
2947 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2949 Elf64_Xword instruction;
2950 Elf64_Sxword rel_value;
2952 rel_value = value - gp_val;
2953 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2954 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2956 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2957 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2958 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2959 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2960 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2961 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2965 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2967 Elf64_Xword instruction;
2968 Elf64_Sxword rel_value;
2971 entry = allocatePLTEntry(value, oc);
2973 rel_value = (entry >> 4) - (target >> 4);
2974 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2975 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2977 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2978 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2979 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2980 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2987 /* --------------------------------------------------------------------------
2989 * ------------------------------------------------------------------------*/
2991 #if defined(OBJFORMAT_MACHO)
2994 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2995 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2997 I hereby formally apologize for the hackish nature of this code.
2998 Things that need to be done:
2999 *) get common symbols and .bss sections to work properly.
3000 Haskell modules seem to work, but C modules can cause problems
3001 *) implement ocVerifyImage_MachO
3002 *) add more sanity checks. The current code just has to segfault if there's a
3006 static int ocVerifyImage_MachO(ObjectCode* oc)
3008 // FIXME: do some verifying here
3012 static int resolveImports(
3015 struct symtab_command *symLC,
3016 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3017 unsigned long *indirectSyms,
3018 struct nlist *nlist)
3022 for(i=0;i*4<sect->size;i++)
3024 // according to otool, reserved1 contains the first index into the indirect symbol table
3025 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3026 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3029 if((symbol->n_type & N_TYPE) == N_UNDF
3030 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3031 addr = (void*) (symbol->n_value);
3032 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3035 addr = lookupSymbol(nm);
3038 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3042 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3043 ((void**)(image + sect->offset))[i] = addr;
3049 static int relocateSection(
3052 struct symtab_command *symLC, struct nlist *nlist,
3053 struct section* sections, struct section *sect)
3055 struct relocation_info *relocs;
3058 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3060 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3064 relocs = (struct relocation_info*) (image + sect->reloff);
3068 if(relocs[i].r_address & R_SCATTERED)
3070 struct scattered_relocation_info *scat =
3071 (struct scattered_relocation_info*) &relocs[i];
3075 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3077 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3079 checkProddableBlock(oc,word);
3080 *word = scat->r_value + sect->offset + ((long) image);
3084 continue; // FIXME: I hope it's OK to ignore all the others.
3088 struct relocation_info *reloc = &relocs[i];
3089 if(reloc->r_pcrel && !reloc->r_extern)
3092 if(reloc->r_length == 2)
3094 unsigned long word = 0;
3096 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3097 checkProddableBlock(oc,wordPtr);
3099 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3103 else if(reloc->r_type == PPC_RELOC_LO16)
3105 word = ((unsigned short*) wordPtr)[1];
3106 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3108 else if(reloc->r_type == PPC_RELOC_HI16)
3110 word = ((unsigned short*) wordPtr)[1] << 16;
3111 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3113 else if(reloc->r_type == PPC_RELOC_HA16)
3115 word = ((unsigned short*) wordPtr)[1] << 16;
3116 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3118 else if(reloc->r_type == PPC_RELOC_BR24)
3121 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3125 if(!reloc->r_extern)
3128 sections[reloc->r_symbolnum-1].offset
3129 - sections[reloc->r_symbolnum-1].addr
3136 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3137 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3138 word = (unsigned long) (lookupSymbol(nm));
3141 belch("\nunknown symbol `%s'", nm);
3146 word -= ((long)image) + sect->offset + reloc->r_address;
3149 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3154 else if(reloc->r_type == PPC_RELOC_LO16)
3156 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3159 else if(reloc->r_type == PPC_RELOC_HI16)
3161 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3164 else if(reloc->r_type == PPC_RELOC_HA16)
3166 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3167 + ((word & (1<<15)) ? 1 : 0);
3170 else if(reloc->r_type == PPC_RELOC_BR24)
3172 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3176 barf("\nunknown relocation %d",reloc->r_type);
3183 static int ocGetNames_MachO(ObjectCode* oc)
3185 char *image = (char*) oc->image;
3186 struct mach_header *header = (struct mach_header*) image;
3187 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3188 unsigned i,curSymbol;
3189 struct segment_command *segLC = NULL;
3190 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3191 struct symtab_command *symLC = NULL;
3192 struct dysymtab_command *dsymLC = NULL;
3193 struct nlist *nlist;
3194 unsigned long commonSize = 0;
3195 char *commonStorage = NULL;
3196 unsigned long commonCounter;
3198 for(i=0;i<header->ncmds;i++)
3200 if(lc->cmd == LC_SEGMENT)
3201 segLC = (struct segment_command*) lc;
3202 else if(lc->cmd == LC_SYMTAB)
3203 symLC = (struct symtab_command*) lc;
3204 else if(lc->cmd == LC_DYSYMTAB)
3205 dsymLC = (struct dysymtab_command*) lc;
3206 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3209 sections = (struct section*) (segLC+1);
3210 nlist = (struct nlist*) (image + symLC->symoff);
3212 for(i=0;i<segLC->nsects;i++)
3214 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3215 la_ptrs = §ions[i];
3216 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3217 nl_ptrs = §ions[i];
3219 // for now, only add __text and __const to the sections table
3220 else if(!strcmp(sections[i].sectname,"__text"))
3221 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3222 (void*) (image + sections[i].offset),
3223 (void*) (image + sections[i].offset + sections[i].size));
3224 else if(!strcmp(sections[i].sectname,"__const"))
3225 addSection(oc, SECTIONKIND_RWDATA,
3226 (void*) (image + sections[i].offset),
3227 (void*) (image + sections[i].offset + sections[i].size));
3228 else if(!strcmp(sections[i].sectname,"__data"))
3229 addSection(oc, SECTIONKIND_RWDATA,
3230 (void*) (image + sections[i].offset),
3231 (void*) (image + sections[i].offset + sections[i].size));
3233 if(sections[i].size > 0) // size 0 segments do exist
3234 addProddableBlock(oc, (void*) (image + sections[i].offset),
3238 // count external symbols defined here
3240 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3242 if((nlist[i].n_type & N_TYPE) == N_SECT)
3245 for(i=0;i<symLC->nsyms;i++)
3247 if((nlist[i].n_type & N_TYPE) == N_UNDF
3248 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3250 commonSize += nlist[i].n_value;
3254 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3255 "ocGetNames_MachO(oc->symbols)");
3257 // insert symbols into hash table
3258 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3260 if((nlist[i].n_type & N_TYPE) == N_SECT)
3262 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3263 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3264 sections[nlist[i].n_sect-1].offset
3265 - sections[nlist[i].n_sect-1].addr
3266 + nlist[i].n_value);
3267 oc->symbols[curSymbol++] = nm;
3271 // insert local symbols into lochash
3272 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3274 if((nlist[i].n_type & N_TYPE) == N_SECT)
3276 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3277 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3278 sections[nlist[i].n_sect-1].offset
3279 - sections[nlist[i].n_sect-1].addr
3280 + nlist[i].n_value);
3285 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3286 commonCounter = (unsigned long)commonStorage;
3287 for(i=0;i<symLC->nsyms;i++)
3289 if((nlist[i].n_type & N_TYPE) == N_UNDF
3290 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3292 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3293 unsigned long sz = nlist[i].n_value;
3295 nlist[i].n_value = commonCounter;
3297 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3298 oc->symbols[curSymbol++] = nm;
3300 commonCounter += sz;
3306 static int ocResolve_MachO(ObjectCode* oc)
3308 char *image = (char*) oc->image;
3309 struct mach_header *header = (struct mach_header*) image;
3310 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3312 struct segment_command *segLC = NULL;
3313 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3314 struct symtab_command *symLC = NULL;
3315 struct dysymtab_command *dsymLC = NULL;
3316 struct nlist *nlist;
3317 unsigned long *indirectSyms;
3319 for(i=0;i<header->ncmds;i++)
3321 if(lc->cmd == LC_SEGMENT)
3322 segLC = (struct segment_command*) lc;
3323 else if(lc->cmd == LC_SYMTAB)
3324 symLC = (struct symtab_command*) lc;
3325 else if(lc->cmd == LC_DYSYMTAB)
3326 dsymLC = (struct dysymtab_command*) lc;
3327 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3330 sections = (struct section*) (segLC+1);
3331 nlist = (struct nlist*) (image + symLC->symoff);
3333 for(i=0;i<segLC->nsects;i++)
3335 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3336 la_ptrs = §ions[i];
3337 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3338 nl_ptrs = §ions[i];
3341 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3344 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3347 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3350 for(i=0;i<segLC->nsects;i++)
3352 if(!relocateSection(oc,image,symLC,nlist,sections,§ions[i]))
3356 /* Free the local symbol table; we won't need it again. */
3357 freeHashTable(oc->lochash, NULL);
3363 * The Mach-O object format uses leading underscores. But not everywhere.
3364 * There is a small number of runtime support functions defined in
3365 * libcc_dynamic.a whose name does not have a leading underscore.
3366 * As a consequence, we can't get their address from C code.
3367 * We have to use inline assembler just to take the address of a function.
3371 static void machoInitSymbolsWithoutUnderscore()
3377 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3378 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3380 RTS_MACHO_NOUNDERLINE_SYMBOLS