1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.128 2003/09/10 14:45:25 simonmar 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>
76 /* Hash table mapping symbol names to Symbol */
77 static /*Str*/HashTable *symhash;
79 /* List of currently loaded objects */
80 ObjectCode *objects = NULL; /* initially empty */
82 #if defined(OBJFORMAT_ELF)
83 static int ocVerifyImage_ELF ( ObjectCode* oc );
84 static int ocGetNames_ELF ( ObjectCode* oc );
85 static int ocResolve_ELF ( ObjectCode* oc );
86 #elif defined(OBJFORMAT_PEi386)
87 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
88 static int ocGetNames_PEi386 ( ObjectCode* oc );
89 static int ocResolve_PEi386 ( ObjectCode* oc );
90 #elif defined(OBJFORMAT_MACHO)
91 static int ocVerifyImage_MachO ( ObjectCode* oc );
92 static int ocGetNames_MachO ( ObjectCode* oc );
93 static int ocResolve_MachO ( ObjectCode* oc );
95 static void machoInitSymbolsWithoutUnderscore( void );
98 /* -----------------------------------------------------------------------------
99 * Built-in symbols from the RTS
102 typedef struct _RtsSymbolVal {
109 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
111 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
112 SymX(makeStableNamezh_fast) \
113 SymX(finalizzeWeakzh_fast)
115 /* These are not available in GUM!!! -- HWL */
116 #define Maybe_ForeignObj
117 #define Maybe_Stable_Names
120 #if !defined (mingw32_TARGET_OS)
121 #define RTS_POSIX_ONLY_SYMBOLS \
122 SymX(stg_sig_install) \
126 #if defined (cygwin32_TARGET_OS)
127 #define RTS_MINGW_ONLY_SYMBOLS /**/
128 /* Don't have the ability to read import libs / archives, so
129 * we have to stupidly list a lot of what libcygwin.a
132 #define RTS_CYGWIN_ONLY_SYMBOLS \
210 #elif !defined(mingw32_TARGET_OS)
211 #define RTS_MINGW_ONLY_SYMBOLS /**/
212 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
213 #else /* defined(mingw32_TARGET_OS) */
214 #define RTS_POSIX_ONLY_SYMBOLS /**/
215 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
217 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
219 #define RTS_MINGW_EXTRA_SYMS \
220 Sym(_imp____mb_cur_max) \
223 #define RTS_MINGW_EXTRA_SYMS
226 /* These are statically linked from the mingw libraries into the ghc
227 executable, so we have to employ this hack. */
228 #define RTS_MINGW_ONLY_SYMBOLS \
229 SymX(asyncReadzh_fast) \
230 SymX(asyncWritezh_fast) \
242 SymX(getservbyname) \
243 SymX(getservbyport) \
244 SymX(getprotobynumber) \
245 SymX(getprotobyname) \
246 SymX(gethostbyname) \
247 SymX(gethostbyaddr) \
282 Sym(_imp___timezone) \
290 RTS_MINGW_EXTRA_SYMS \
295 # define MAIN_CAP_SYM SymX(MainCapability)
297 # define MAIN_CAP_SYM
300 #define RTS_SYMBOLS \
304 SymX(stg_enter_info) \
305 SymX(stg_enter_ret) \
306 SymX(stg_gc_void_info) \
307 SymX(__stg_gc_enter_1) \
308 SymX(stg_gc_noregs) \
309 SymX(stg_gc_unpt_r1_info) \
310 SymX(stg_gc_unpt_r1) \
311 SymX(stg_gc_unbx_r1_info) \
312 SymX(stg_gc_unbx_r1) \
313 SymX(stg_gc_f1_info) \
315 SymX(stg_gc_d1_info) \
317 SymX(stg_gc_l1_info) \
320 SymX(stg_gc_fun_info) \
321 SymX(stg_gc_fun_ret) \
323 SymX(stg_gc_gen_info) \
324 SymX(stg_gc_gen_hp) \
326 SymX(stg_gen_yield) \
327 SymX(stg_yield_noregs) \
328 SymX(stg_yield_to_interpreter) \
329 SymX(stg_gen_block) \
330 SymX(stg_block_noregs) \
332 SymX(stg_block_takemvar) \
333 SymX(stg_block_putmvar) \
334 SymX(stg_seq_frame_info) \
337 SymX(MallocFailHook) \
339 SymX(OutOfHeapHook) \
340 SymX(PatErrorHdrHook) \
341 SymX(PostTraceHook) \
343 SymX(StackOverflowHook) \
344 SymX(__encodeDouble) \
345 SymX(__encodeFloat) \
348 SymX(__gmpz_cmp_si) \
349 SymX(__gmpz_cmp_ui) \
350 SymX(__gmpz_get_si) \
351 SymX(__gmpz_get_ui) \
352 SymX(__int_encodeDouble) \
353 SymX(__int_encodeFloat) \
354 SymX(andIntegerzh_fast) \
355 SymX(blockAsyncExceptionszh_fast) \
358 SymX(complementIntegerzh_fast) \
359 SymX(cmpIntegerzh_fast) \
360 SymX(cmpIntegerIntzh_fast) \
361 SymX(createAdjustor) \
362 SymX(decodeDoublezh_fast) \
363 SymX(decodeFloatzh_fast) \
366 SymX(deRefWeakzh_fast) \
367 SymX(deRefStablePtrzh_fast) \
368 SymX(divExactIntegerzh_fast) \
369 SymX(divModIntegerzh_fast) \
371 SymX(forkProcesszh_fast) \
372 SymX(freeHaskellFunctionPtr) \
373 SymX(freeStablePtr) \
374 SymX(gcdIntegerzh_fast) \
375 SymX(gcdIntegerIntzh_fast) \
376 SymX(gcdIntzh_fast) \
380 SymX(int2Integerzh_fast) \
381 SymX(integer2Intzh_fast) \
382 SymX(integer2Wordzh_fast) \
383 SymX(isDoubleDenormalized) \
384 SymX(isDoubleInfinite) \
386 SymX(isDoubleNegativeZero) \
387 SymX(isEmptyMVarzh_fast) \
388 SymX(isFloatDenormalized) \
389 SymX(isFloatInfinite) \
391 SymX(isFloatNegativeZero) \
392 SymX(killThreadzh_fast) \
393 SymX(makeStablePtrzh_fast) \
394 SymX(minusIntegerzh_fast) \
395 SymX(mkApUpd0zh_fast) \
396 SymX(myThreadIdzh_fast) \
397 SymX(labelThreadzh_fast) \
398 SymX(newArrayzh_fast) \
399 SymX(newBCOzh_fast) \
400 SymX(newByteArrayzh_fast) \
401 SymX_redirect(newCAF, newDynCAF) \
402 SymX(newMVarzh_fast) \
403 SymX(newMutVarzh_fast) \
404 SymX(atomicModifyMutVarzh_fast) \
405 SymX(newPinnedByteArrayzh_fast) \
406 SymX(orIntegerzh_fast) \
408 SymX(plusIntegerzh_fast) \
411 SymX(putMVarzh_fast) \
412 SymX(quotIntegerzh_fast) \
413 SymX(quotRemIntegerzh_fast) \
415 SymX(raiseIOzh_fast) \
416 SymX(remIntegerzh_fast) \
417 SymX(resetNonBlockingFd) \
420 SymX(rts_checkSchedStatus) \
423 SymX(rts_evalLazyIO) \
427 SymX(rts_getDouble) \
432 SymX(rts_getFunPtr) \
433 SymX(rts_getStablePtr) \
434 SymX(rts_getThreadId) \
436 SymX(rts_getWord32) \
449 SymX(rts_mkStablePtr) \
459 SymX(startupHaskell) \
460 SymX(shutdownHaskell) \
461 SymX(shutdownHaskellAndExit) \
462 SymX(stable_ptr_table) \
463 SymX(stackOverflow) \
464 SymX(stg_CAF_BLACKHOLE_info) \
465 SymX(stg_BLACKHOLE_BQ_info) \
466 SymX(awakenBlockedQueue) \
467 SymX(stg_CHARLIKE_closure) \
468 SymX(stg_EMPTY_MVAR_info) \
469 SymX(stg_IND_STATIC_info) \
470 SymX(stg_INTLIKE_closure) \
471 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
472 SymX(stg_WEAK_info) \
473 SymX(stg_ap_v_info) \
474 SymX(stg_ap_f_info) \
475 SymX(stg_ap_d_info) \
476 SymX(stg_ap_l_info) \
477 SymX(stg_ap_n_info) \
478 SymX(stg_ap_p_info) \
479 SymX(stg_ap_pv_info) \
480 SymX(stg_ap_pp_info) \
481 SymX(stg_ap_ppv_info) \
482 SymX(stg_ap_ppp_info) \
483 SymX(stg_ap_pppp_info) \
484 SymX(stg_ap_ppppp_info) \
485 SymX(stg_ap_pppppp_info) \
486 SymX(stg_ap_ppppppp_info) \
494 SymX(stg_ap_pv_ret) \
495 SymX(stg_ap_pp_ret) \
496 SymX(stg_ap_ppv_ret) \
497 SymX(stg_ap_ppp_ret) \
498 SymX(stg_ap_pppp_ret) \
499 SymX(stg_ap_ppppp_ret) \
500 SymX(stg_ap_pppppp_ret) \
501 SymX(stg_ap_ppppppp_ret) \
502 SymX(stg_ap_1_upd_info) \
503 SymX(stg_ap_2_upd_info) \
504 SymX(stg_ap_3_upd_info) \
505 SymX(stg_ap_4_upd_info) \
506 SymX(stg_ap_5_upd_info) \
507 SymX(stg_ap_6_upd_info) \
508 SymX(stg_ap_7_upd_info) \
509 SymX(stg_ap_8_upd_info) \
511 SymX(stg_sel_0_upd_info) \
512 SymX(stg_sel_10_upd_info) \
513 SymX(stg_sel_11_upd_info) \
514 SymX(stg_sel_12_upd_info) \
515 SymX(stg_sel_13_upd_info) \
516 SymX(stg_sel_14_upd_info) \
517 SymX(stg_sel_15_upd_info) \
518 SymX(stg_sel_1_upd_info) \
519 SymX(stg_sel_2_upd_info) \
520 SymX(stg_sel_3_upd_info) \
521 SymX(stg_sel_4_upd_info) \
522 SymX(stg_sel_5_upd_info) \
523 SymX(stg_sel_6_upd_info) \
524 SymX(stg_sel_7_upd_info) \
525 SymX(stg_sel_8_upd_info) \
526 SymX(stg_sel_9_upd_info) \
527 SymX(stg_upd_frame_info) \
528 SymX(suspendThread) \
529 SymX(takeMVarzh_fast) \
530 SymX(timesIntegerzh_fast) \
531 SymX(tryPutMVarzh_fast) \
532 SymX(tryTakeMVarzh_fast) \
533 SymX(unblockAsyncExceptionszh_fast) \
534 SymX(unsafeThawArrayzh_fast) \
535 SymX(waitReadzh_fast) \
536 SymX(waitWritezh_fast) \
537 SymX(word2Integerzh_fast) \
538 SymX(xorIntegerzh_fast) \
541 #ifdef SUPPORT_LONG_LONGS
542 #define RTS_LONG_LONG_SYMS \
543 SymX(int64ToIntegerzh_fast) \
544 SymX(word64ToIntegerzh_fast)
546 #define RTS_LONG_LONG_SYMS /* nothing */
549 // 64-bit support functions in libgcc.a
550 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
551 #define RTS_LIBGCC_SYMBOLS \
560 #elif defined(ia64_TARGET_ARCH)
561 #define RTS_LIBGCC_SYMBOLS \
569 #define RTS_LIBGCC_SYMBOLS
572 #ifdef darwin_TARGET_OS
573 // Symbols that don't have a leading underscore
574 // on Mac OS X. They have to receive special treatment,
575 // see machoInitSymbolsWithoutUnderscore()
576 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
581 /* entirely bogus claims about types of these symbols */
582 #define Sym(vvv) extern void vvv(void);
583 #define SymX(vvv) /**/
584 #define SymX_redirect(vvv,xxx) /**/
587 RTS_POSIX_ONLY_SYMBOLS
588 RTS_MINGW_ONLY_SYMBOLS
589 RTS_CYGWIN_ONLY_SYMBOLS
595 #ifdef LEADING_UNDERSCORE
596 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
598 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
601 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
603 #define SymX(vvv) Sym(vvv)
605 // SymX_redirect allows us to redirect references to one symbol to
606 // another symbol. See newCAF/newDynCAF for an example.
607 #define SymX_redirect(vvv,xxx) \
608 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
611 static RtsSymbolVal rtsSyms[] = {
614 RTS_POSIX_ONLY_SYMBOLS
615 RTS_MINGW_ONLY_SYMBOLS
616 RTS_CYGWIN_ONLY_SYMBOLS
618 { 0, 0 } /* sentinel */
621 /* -----------------------------------------------------------------------------
622 * Insert symbols into hash tables, checking for duplicates.
624 static void ghciInsertStrHashTable ( char* obj_name,
630 if (lookupHashTable(table, (StgWord)key) == NULL)
632 insertStrHashTable(table, (StgWord)key, data);
637 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
639 "whilst processing object file\n"
641 "This could be caused by:\n"
642 " * Loading two different object files which export the same symbol\n"
643 " * Specifying the same object file twice on the GHCi command line\n"
644 " * An incorrect `package.conf' entry, causing some object to be\n"
646 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
655 /* -----------------------------------------------------------------------------
656 * initialize the object linker
660 static int linker_init_done = 0 ;
662 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
663 static void *dl_prog_handle;
671 /* Make initLinker idempotent, so we can call it
672 before evey relevant operation; that means we
673 don't need to initialise the linker separately */
674 if (linker_init_done == 1) { return; } else {
675 linker_init_done = 1;
678 symhash = allocStrHashTable();
680 /* populate the symbol table with stuff from the RTS */
681 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
682 ghciInsertStrHashTable("(GHCi built-in symbols)",
683 symhash, sym->lbl, sym->addr);
685 # if defined(OBJFORMAT_MACHO)
686 machoInitSymbolsWithoutUnderscore();
689 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
690 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
694 /* -----------------------------------------------------------------------------
695 * Loading DLL or .so dynamic libraries
696 * -----------------------------------------------------------------------------
698 * Add a DLL from which symbols may be found. In the ELF case, just
699 * do RTLD_GLOBAL-style add, so no further messing around needs to
700 * happen in order that symbols in the loaded .so are findable --
701 * lookupSymbol() will subsequently see them by dlsym on the program's
702 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
704 * In the PEi386 case, open the DLLs and put handles to them in a
705 * linked list. When looking for a symbol, try all handles in the
706 * list. This means that we need to load even DLLs that are guaranteed
707 * to be in the ghc.exe image already, just so we can get a handle
708 * to give to loadSymbol, so that we can find the symbols. For such
709 * libraries, the LoadLibrary call should be a no-op except for returning
714 #if defined(OBJFORMAT_PEi386)
715 /* A record for storing handles into DLLs. */
720 struct _OpenedDLL* next;
725 /* A list thereof. */
726 static OpenedDLL* opened_dlls = NULL;
730 addDLL( char *dll_name )
732 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
733 /* ------------------- ELF DLL loader ------------------- */
739 #if !defined(openbsd_TARGET_OS)
740 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
742 hdl= dlopen(dll_name, RTLD_LAZY);
745 /* dlopen failed; return a ptr to the error msg. */
747 if (errmsg == NULL) errmsg = "addDLL: unknown error";
754 # elif defined(OBJFORMAT_PEi386)
755 /* ------------------- Win32 DLL loader ------------------- */
763 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
765 /* See if we've already got it, and ignore if so. */
766 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
767 if (0 == strcmp(o_dll->name, dll_name))
771 /* The file name has no suffix (yet) so that we can try
772 both foo.dll and foo.drv
774 The documentation for LoadLibrary says:
775 If no file name extension is specified in the lpFileName
776 parameter, the default library extension .dll is
777 appended. However, the file name string can include a trailing
778 point character (.) to indicate that the module name has no
781 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
782 sprintf(buf, "%s.DLL", dll_name);
783 instance = LoadLibrary(buf);
784 if (instance == NULL) {
785 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
786 instance = LoadLibrary(buf);
787 if (instance == NULL) {
790 /* LoadLibrary failed; return a ptr to the error msg. */
791 return "addDLL: unknown error";
796 /* Add this DLL to the list of DLLs in which to search for symbols. */
797 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
798 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
799 strcpy(o_dll->name, dll_name);
800 o_dll->instance = instance;
801 o_dll->next = opened_dlls;
806 barf("addDLL: not implemented on this platform");
810 /* -----------------------------------------------------------------------------
811 * lookup a symbol in the hash table
814 lookupSymbol( char *lbl )
818 ASSERT(symhash != NULL);
819 val = lookupStrHashTable(symhash, lbl);
822 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
823 return dlsym(dl_prog_handle, lbl);
824 # elif defined(OBJFORMAT_PEi386)
827 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
828 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
830 /* HACK: if the name has an initial underscore, try stripping
831 it off & look that up first. I've yet to verify whether there's
832 a Rule that governs whether an initial '_' *should always* be
833 stripped off when mapping from import lib name to the DLL name.
835 sym = GetProcAddress(o_dll->instance, (lbl+1));
837 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
841 sym = GetProcAddress(o_dll->instance, lbl);
843 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
858 __attribute((unused))
860 lookupLocalSymbol( ObjectCode* oc, char *lbl )
864 val = lookupStrHashTable(oc->lochash, lbl);
874 /* -----------------------------------------------------------------------------
875 * Debugging aid: look in GHCi's object symbol tables for symbols
876 * within DELTA bytes of the specified address, and show their names.
879 void ghci_enquire ( char* addr );
881 void ghci_enquire ( char* addr )
886 const int DELTA = 64;
891 for (oc = objects; oc; oc = oc->next) {
892 for (i = 0; i < oc->n_symbols; i++) {
893 sym = oc->symbols[i];
894 if (sym == NULL) continue;
895 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
897 if (oc->lochash != NULL) {
898 a = lookupStrHashTable(oc->lochash, sym);
901 a = lookupStrHashTable(symhash, sym);
904 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
906 else if (addr-DELTA <= a && a <= addr+DELTA) {
907 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
914 #ifdef ia64_TARGET_ARCH
915 static unsigned int PLTSize(void);
918 /* -----------------------------------------------------------------------------
919 * Load an obj (populate the global symbol table, but don't resolve yet)
921 * Returns: 1 if ok, 0 on error.
924 loadObj( char *path )
938 /* fprintf(stderr, "loadObj %s\n", path ); */
940 /* Check that we haven't already loaded this object. Don't give up
941 at this stage; ocGetNames_* will barf later. */
945 for (o = objects; o; o = o->next) {
946 if (0 == strcmp(o->fileName, path))
952 "GHCi runtime linker: warning: looks like you're trying to load the\n"
953 "same object file twice:\n"
955 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
961 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
963 # if defined(OBJFORMAT_ELF)
964 oc->formatName = "ELF";
965 # elif defined(OBJFORMAT_PEi386)
966 oc->formatName = "PEi386";
967 # elif defined(OBJFORMAT_MACHO)
968 oc->formatName = "Mach-O";
971 barf("loadObj: not implemented on this platform");
975 if (r == -1) { return 0; }
977 /* sigh, strdup() isn't a POSIX function, so do it the long way */
978 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
979 strcpy(oc->fileName, path);
981 oc->fileSize = st.st_size;
984 oc->lochash = allocStrHashTable();
985 oc->proddables = NULL;
987 /* chain it onto the list of objects */
992 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
994 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
996 fd = open(path, O_RDONLY);
998 barf("loadObj: can't open `%s'", path);
1000 pagesize = getpagesize();
1002 #ifdef ia64_TARGET_ARCH
1003 /* The PLT needs to be right before the object */
1004 n = ROUND_UP(PLTSize(), pagesize);
1005 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1006 if (oc->plt == MAP_FAILED)
1007 barf("loadObj: can't allocate PLT");
1010 map_addr = oc->plt + n;
1013 n = ROUND_UP(oc->fileSize, pagesize);
1014 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1015 if (oc->image == MAP_FAILED)
1016 barf("loadObj: can't map `%s'", path);
1020 #else /* !USE_MMAP */
1022 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1024 /* load the image into memory */
1025 f = fopen(path, "rb");
1027 barf("loadObj: can't read `%s'", path);
1029 n = fread ( oc->image, 1, oc->fileSize, f );
1030 if (n != oc->fileSize)
1031 barf("loadObj: error whilst reading `%s'", path);
1035 #endif /* USE_MMAP */
1037 /* verify the in-memory image */
1038 # if defined(OBJFORMAT_ELF)
1039 r = ocVerifyImage_ELF ( oc );
1040 # elif defined(OBJFORMAT_PEi386)
1041 r = ocVerifyImage_PEi386 ( oc );
1042 # elif defined(OBJFORMAT_MACHO)
1043 r = ocVerifyImage_MachO ( oc );
1045 barf("loadObj: no verify method");
1047 if (!r) { return r; }
1049 /* build the symbol list for this image */
1050 # if defined(OBJFORMAT_ELF)
1051 r = ocGetNames_ELF ( oc );
1052 # elif defined(OBJFORMAT_PEi386)
1053 r = ocGetNames_PEi386 ( oc );
1054 # elif defined(OBJFORMAT_MACHO)
1055 r = ocGetNames_MachO ( oc );
1057 barf("loadObj: no getNames method");
1059 if (!r) { return r; }
1061 /* loaded, but not resolved yet */
1062 oc->status = OBJECT_LOADED;
1067 /* -----------------------------------------------------------------------------
1068 * resolve all the currently unlinked objects in memory
1070 * Returns: 1 if ok, 0 on error.
1080 for (oc = objects; oc; oc = oc->next) {
1081 if (oc->status != OBJECT_RESOLVED) {
1082 # if defined(OBJFORMAT_ELF)
1083 r = ocResolve_ELF ( oc );
1084 # elif defined(OBJFORMAT_PEi386)
1085 r = ocResolve_PEi386 ( oc );
1086 # elif defined(OBJFORMAT_MACHO)
1087 r = ocResolve_MachO ( oc );
1089 barf("resolveObjs: not implemented on this platform");
1091 if (!r) { return r; }
1092 oc->status = OBJECT_RESOLVED;
1098 /* -----------------------------------------------------------------------------
1099 * delete an object from the pool
1102 unloadObj( char *path )
1104 ObjectCode *oc, *prev;
1106 ASSERT(symhash != NULL);
1107 ASSERT(objects != NULL);
1112 for (oc = objects; oc; prev = oc, oc = oc->next) {
1113 if (!strcmp(oc->fileName,path)) {
1115 /* Remove all the mappings for the symbols within this
1120 for (i = 0; i < oc->n_symbols; i++) {
1121 if (oc->symbols[i] != NULL) {
1122 removeStrHashTable(symhash, oc->symbols[i], NULL);
1130 prev->next = oc->next;
1133 /* We're going to leave this in place, in case there are
1134 any pointers from the heap into it: */
1135 /* stgFree(oc->image); */
1136 stgFree(oc->fileName);
1137 stgFree(oc->symbols);
1138 stgFree(oc->sections);
1139 /* The local hash table should have been freed at the end
1140 of the ocResolve_ call on it. */
1141 ASSERT(oc->lochash == NULL);
1147 belch("unloadObj: can't find `%s' to unload", path);
1151 /* -----------------------------------------------------------------------------
1152 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1153 * which may be prodded during relocation, and abort if we try and write
1154 * outside any of these.
1156 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1159 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1160 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1164 pb->next = oc->proddables;
1165 oc->proddables = pb;
1168 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1171 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1172 char* s = (char*)(pb->start);
1173 char* e = s + pb->size - 1;
1174 char* a = (char*)addr;
1175 /* Assumes that the biggest fixup involves a 4-byte write. This
1176 probably needs to be changed to 8 (ie, +7) on 64-bit
1178 if (a >= s && (a+3) <= e) return;
1180 barf("checkProddableBlock: invalid fixup in runtime linker");
1183 /* -----------------------------------------------------------------------------
1184 * Section management.
1186 static void addSection ( ObjectCode* oc, SectionKind kind,
1187 void* start, void* end )
1189 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1193 s->next = oc->sections;
1196 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1197 start, ((char*)end)-1, end - start + 1, kind );
1203 /* --------------------------------------------------------------------------
1204 * PEi386 specifics (Win32 targets)
1205 * ------------------------------------------------------------------------*/
1207 /* The information for this linker comes from
1208 Microsoft Portable Executable
1209 and Common Object File Format Specification
1210 revision 5.1 January 1998
1211 which SimonM says comes from the MS Developer Network CDs.
1213 It can be found there (on older CDs), but can also be found
1216 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1218 (this is Rev 6.0 from February 1999).
1220 Things move, so if that fails, try searching for it via
1222 http://www.google.com/search?q=PE+COFF+specification
1224 The ultimate reference for the PE format is the Winnt.h
1225 header file that comes with the Platform SDKs; as always,
1226 implementations will drift wrt their documentation.
1228 A good background article on the PE format is Matt Pietrek's
1229 March 1994 article in Microsoft System Journal (MSJ)
1230 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1231 Win32 Portable Executable File Format." The info in there
1232 has recently been updated in a two part article in
1233 MSDN magazine, issues Feb and March 2002,
1234 "Inside Windows: An In-Depth Look into the Win32 Portable
1235 Executable File Format"
1237 John Levine's book "Linkers and Loaders" contains useful
1242 #if defined(OBJFORMAT_PEi386)
1246 typedef unsigned char UChar;
1247 typedef unsigned short UInt16;
1248 typedef unsigned int UInt32;
1255 UInt16 NumberOfSections;
1256 UInt32 TimeDateStamp;
1257 UInt32 PointerToSymbolTable;
1258 UInt32 NumberOfSymbols;
1259 UInt16 SizeOfOptionalHeader;
1260 UInt16 Characteristics;
1264 #define sizeof_COFF_header 20
1271 UInt32 VirtualAddress;
1272 UInt32 SizeOfRawData;
1273 UInt32 PointerToRawData;
1274 UInt32 PointerToRelocations;
1275 UInt32 PointerToLinenumbers;
1276 UInt16 NumberOfRelocations;
1277 UInt16 NumberOfLineNumbers;
1278 UInt32 Characteristics;
1282 #define sizeof_COFF_section 40
1289 UInt16 SectionNumber;
1292 UChar NumberOfAuxSymbols;
1296 #define sizeof_COFF_symbol 18
1301 UInt32 VirtualAddress;
1302 UInt32 SymbolTableIndex;
1307 #define sizeof_COFF_reloc 10
1310 /* From PE spec doc, section 3.3.2 */
1311 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1312 windows.h -- for the same purpose, but I want to know what I'm
1314 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1315 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1316 #define MYIMAGE_FILE_DLL 0x2000
1317 #define MYIMAGE_FILE_SYSTEM 0x1000
1318 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1319 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1320 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1322 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1323 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1324 #define MYIMAGE_SYM_CLASS_STATIC 3
1325 #define MYIMAGE_SYM_UNDEFINED 0
1327 /* From PE spec doc, section 4.1 */
1328 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1329 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1330 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1332 /* From PE spec doc, section 5.2.1 */
1333 #define MYIMAGE_REL_I386_DIR32 0x0006
1334 #define MYIMAGE_REL_I386_REL32 0x0014
1337 /* We use myindex to calculate array addresses, rather than
1338 simply doing the normal subscript thing. That's because
1339 some of the above structs have sizes which are not
1340 a whole number of words. GCC rounds their sizes up to a
1341 whole number of words, which means that the address calcs
1342 arising from using normal C indexing or pointer arithmetic
1343 are just plain wrong. Sigh.
1346 myindex ( int scale, void* base, int index )
1349 ((UChar*)base) + scale * index;
1354 printName ( UChar* name, UChar* strtab )
1356 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1357 UInt32 strtab_offset = * (UInt32*)(name+4);
1358 fprintf ( stderr, "%s", strtab + strtab_offset );
1361 for (i = 0; i < 8; i++) {
1362 if (name[i] == 0) break;
1363 fprintf ( stderr, "%c", name[i] );
1370 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1372 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1373 UInt32 strtab_offset = * (UInt32*)(name+4);
1374 strncpy ( dst, strtab+strtab_offset, dstSize );
1380 if (name[i] == 0) break;
1390 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1393 /* If the string is longer than 8 bytes, look in the
1394 string table for it -- this will be correctly zero terminated.
1396 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1397 UInt32 strtab_offset = * (UInt32*)(name+4);
1398 return ((UChar*)strtab) + strtab_offset;
1400 /* Otherwise, if shorter than 8 bytes, return the original,
1401 which by defn is correctly terminated.
1403 if (name[7]==0) return name;
1404 /* The annoying case: 8 bytes. Copy into a temporary
1405 (which is never freed ...)
1407 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1409 strncpy(newstr,name,8);
1415 /* Just compares the short names (first 8 chars) */
1416 static COFF_section *
1417 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1421 = (COFF_header*)(oc->image);
1422 COFF_section* sectab
1424 ((UChar*)(oc->image))
1425 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1427 for (i = 0; i < hdr->NumberOfSections; i++) {
1430 COFF_section* section_i
1432 myindex ( sizeof_COFF_section, sectab, i );
1433 n1 = (UChar*) &(section_i->Name);
1435 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1436 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1437 n1[6]==n2[6] && n1[7]==n2[7])
1446 zapTrailingAtSign ( UChar* sym )
1448 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1450 if (sym[0] == 0) return;
1452 while (sym[i] != 0) i++;
1455 while (j > 0 && my_isdigit(sym[j])) j--;
1456 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1462 ocVerifyImage_PEi386 ( ObjectCode* oc )
1467 COFF_section* sectab;
1468 COFF_symbol* symtab;
1470 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1471 hdr = (COFF_header*)(oc->image);
1472 sectab = (COFF_section*) (
1473 ((UChar*)(oc->image))
1474 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1476 symtab = (COFF_symbol*) (
1477 ((UChar*)(oc->image))
1478 + hdr->PointerToSymbolTable
1480 strtab = ((UChar*)symtab)
1481 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1483 if (hdr->Machine != 0x14c) {
1484 belch("Not x86 PEi386");
1487 if (hdr->SizeOfOptionalHeader != 0) {
1488 belch("PEi386 with nonempty optional header");
1491 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1492 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1493 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1494 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1495 belch("Not a PEi386 object file");
1498 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1499 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1500 belch("Invalid PEi386 word size or endiannness: %d",
1501 (int)(hdr->Characteristics));
1504 /* If the string table size is way crazy, this might indicate that
1505 there are more than 64k relocations, despite claims to the
1506 contrary. Hence this test. */
1507 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1509 if ( (*(UInt32*)strtab) > 600000 ) {
1510 /* Note that 600k has no special significance other than being
1511 big enough to handle the almost-2MB-sized lumps that
1512 constitute HSwin32*.o. */
1513 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1518 /* No further verification after this point; only debug printing. */
1520 IF_DEBUG(linker, i=1);
1521 if (i == 0) return 1;
1524 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1526 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1528 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1530 fprintf ( stderr, "\n" );
1532 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1534 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1536 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1538 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1540 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1542 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1544 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1546 /* Print the section table. */
1547 fprintf ( stderr, "\n" );
1548 for (i = 0; i < hdr->NumberOfSections; i++) {
1550 COFF_section* sectab_i
1552 myindex ( sizeof_COFF_section, sectab, i );
1559 printName ( sectab_i->Name, strtab );
1569 sectab_i->VirtualSize,
1570 sectab_i->VirtualAddress,
1571 sectab_i->SizeOfRawData,
1572 sectab_i->PointerToRawData,
1573 sectab_i->NumberOfRelocations,
1574 sectab_i->PointerToRelocations,
1575 sectab_i->PointerToRawData
1577 reltab = (COFF_reloc*) (
1578 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1581 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1582 /* If the relocation field (a short) has overflowed, the
1583 * real count can be found in the first reloc entry.
1585 * See Section 4.1 (last para) of the PE spec (rev6.0).
1587 COFF_reloc* rel = (COFF_reloc*)
1588 myindex ( sizeof_COFF_reloc, reltab, 0 );
1589 noRelocs = rel->VirtualAddress;
1592 noRelocs = sectab_i->NumberOfRelocations;
1596 for (; j < noRelocs; j++) {
1598 COFF_reloc* rel = (COFF_reloc*)
1599 myindex ( sizeof_COFF_reloc, reltab, j );
1601 " type 0x%-4x vaddr 0x%-8x name `",
1603 rel->VirtualAddress );
1604 sym = (COFF_symbol*)
1605 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1606 /* Hmm..mysterious looking offset - what's it for? SOF */
1607 printName ( sym->Name, strtab -10 );
1608 fprintf ( stderr, "'\n" );
1611 fprintf ( stderr, "\n" );
1613 fprintf ( stderr, "\n" );
1614 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1615 fprintf ( stderr, "---START of string table---\n");
1616 for (i = 4; i < *(Int32*)strtab; i++) {
1618 fprintf ( stderr, "\n"); else
1619 fprintf( stderr, "%c", strtab[i] );
1621 fprintf ( stderr, "--- END of string table---\n");
1623 fprintf ( stderr, "\n" );
1626 COFF_symbol* symtab_i;
1627 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1628 symtab_i = (COFF_symbol*)
1629 myindex ( sizeof_COFF_symbol, symtab, i );
1635 printName ( symtab_i->Name, strtab );
1644 (Int32)(symtab_i->SectionNumber),
1645 (UInt32)symtab_i->Type,
1646 (UInt32)symtab_i->StorageClass,
1647 (UInt32)symtab_i->NumberOfAuxSymbols
1649 i += symtab_i->NumberOfAuxSymbols;
1653 fprintf ( stderr, "\n" );
1659 ocGetNames_PEi386 ( ObjectCode* oc )
1662 COFF_section* sectab;
1663 COFF_symbol* symtab;
1670 hdr = (COFF_header*)(oc->image);
1671 sectab = (COFF_section*) (
1672 ((UChar*)(oc->image))
1673 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1675 symtab = (COFF_symbol*) (
1676 ((UChar*)(oc->image))
1677 + hdr->PointerToSymbolTable
1679 strtab = ((UChar*)(oc->image))
1680 + hdr->PointerToSymbolTable
1681 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1683 /* Allocate space for any (local, anonymous) .bss sections. */
1685 for (i = 0; i < hdr->NumberOfSections; i++) {
1687 COFF_section* sectab_i
1689 myindex ( sizeof_COFF_section, sectab, i );
1690 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1691 if (sectab_i->VirtualSize == 0) continue;
1692 /* This is a non-empty .bss section. Allocate zeroed space for
1693 it, and set its PointerToRawData field such that oc->image +
1694 PointerToRawData == addr_of_zeroed_space. */
1695 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1696 "ocGetNames_PEi386(anonymous bss)");
1697 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1698 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1699 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1702 /* Copy section information into the ObjectCode. */
1704 for (i = 0; i < hdr->NumberOfSections; i++) {
1710 = SECTIONKIND_OTHER;
1711 COFF_section* sectab_i
1713 myindex ( sizeof_COFF_section, sectab, i );
1714 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1717 /* I'm sure this is the Right Way to do it. However, the
1718 alternative of testing the sectab_i->Name field seems to
1719 work ok with Cygwin.
1721 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1722 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1723 kind = SECTIONKIND_CODE_OR_RODATA;
1726 if (0==strcmp(".text",sectab_i->Name) ||
1727 0==strcmp(".rodata",sectab_i->Name))
1728 kind = SECTIONKIND_CODE_OR_RODATA;
1729 if (0==strcmp(".data",sectab_i->Name) ||
1730 0==strcmp(".bss",sectab_i->Name))
1731 kind = SECTIONKIND_RWDATA;
1733 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1734 sz = sectab_i->SizeOfRawData;
1735 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1737 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1738 end = start + sz - 1;
1740 if (kind == SECTIONKIND_OTHER
1741 /* Ignore sections called which contain stabs debugging
1743 && 0 != strcmp(".stab", sectab_i->Name)
1744 && 0 != strcmp(".stabstr", sectab_i->Name)
1746 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1750 if (kind != SECTIONKIND_OTHER && end >= start) {
1751 addSection(oc, kind, start, end);
1752 addProddableBlock(oc, start, end - start + 1);
1756 /* Copy exported symbols into the ObjectCode. */
1758 oc->n_symbols = hdr->NumberOfSymbols;
1759 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1760 "ocGetNames_PEi386(oc->symbols)");
1761 /* Call me paranoid; I don't care. */
1762 for (i = 0; i < oc->n_symbols; i++)
1763 oc->symbols[i] = NULL;
1767 COFF_symbol* symtab_i;
1768 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1769 symtab_i = (COFF_symbol*)
1770 myindex ( sizeof_COFF_symbol, symtab, i );
1774 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1775 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1776 /* This symbol is global and defined, viz, exported */
1777 /* for MYIMAGE_SYMCLASS_EXTERNAL
1778 && !MYIMAGE_SYM_UNDEFINED,
1779 the address of the symbol is:
1780 address of relevant section + offset in section
1782 COFF_section* sectabent
1783 = (COFF_section*) myindex ( sizeof_COFF_section,
1785 symtab_i->SectionNumber-1 );
1786 addr = ((UChar*)(oc->image))
1787 + (sectabent->PointerToRawData
1791 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1792 && symtab_i->Value > 0) {
1793 /* This symbol isn't in any section at all, ie, global bss.
1794 Allocate zeroed space for it. */
1795 addr = stgCallocBytes(1, symtab_i->Value,
1796 "ocGetNames_PEi386(non-anonymous bss)");
1797 addSection(oc, SECTIONKIND_RWDATA, addr,
1798 ((UChar*)addr) + symtab_i->Value - 1);
1799 addProddableBlock(oc, addr, symtab_i->Value);
1800 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1803 if (addr != NULL ) {
1804 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1805 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1806 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1807 ASSERT(i >= 0 && i < oc->n_symbols);
1808 /* cstring_from_COFF_symbol_name always succeeds. */
1809 oc->symbols[i] = sname;
1810 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1814 "IGNORING symbol %d\n"
1818 printName ( symtab_i->Name, strtab );
1827 (Int32)(symtab_i->SectionNumber),
1828 (UInt32)symtab_i->Type,
1829 (UInt32)symtab_i->StorageClass,
1830 (UInt32)symtab_i->NumberOfAuxSymbols
1835 i += symtab_i->NumberOfAuxSymbols;
1844 ocResolve_PEi386 ( ObjectCode* oc )
1847 COFF_section* sectab;
1848 COFF_symbol* symtab;
1858 /* ToDo: should be variable-sized? But is at least safe in the
1859 sense of buffer-overrun-proof. */
1861 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1863 hdr = (COFF_header*)(oc->image);
1864 sectab = (COFF_section*) (
1865 ((UChar*)(oc->image))
1866 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1868 symtab = (COFF_symbol*) (
1869 ((UChar*)(oc->image))
1870 + hdr->PointerToSymbolTable
1872 strtab = ((UChar*)(oc->image))
1873 + hdr->PointerToSymbolTable
1874 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1876 for (i = 0; i < hdr->NumberOfSections; i++) {
1877 COFF_section* sectab_i
1879 myindex ( sizeof_COFF_section, sectab, i );
1882 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1885 /* Ignore sections called which contain stabs debugging
1887 if (0 == strcmp(".stab", sectab_i->Name)
1888 || 0 == strcmp(".stabstr", sectab_i->Name))
1891 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1892 /* If the relocation field (a short) has overflowed, the
1893 * real count can be found in the first reloc entry.
1895 * See Section 4.1 (last para) of the PE spec (rev6.0).
1897 COFF_reloc* rel = (COFF_reloc*)
1898 myindex ( sizeof_COFF_reloc, reltab, 0 );
1899 noRelocs = rel->VirtualAddress;
1900 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1903 noRelocs = sectab_i->NumberOfRelocations;
1908 for (; j < noRelocs; j++) {
1910 COFF_reloc* reltab_j
1912 myindex ( sizeof_COFF_reloc, reltab, j );
1914 /* the location to patch */
1916 ((UChar*)(oc->image))
1917 + (sectab_i->PointerToRawData
1918 + reltab_j->VirtualAddress
1919 - sectab_i->VirtualAddress )
1921 /* the existing contents of pP */
1923 /* the symbol to connect to */
1924 sym = (COFF_symbol*)
1925 myindex ( sizeof_COFF_symbol,
1926 symtab, reltab_j->SymbolTableIndex );
1929 "reloc sec %2d num %3d: type 0x%-4x "
1930 "vaddr 0x%-8x name `",
1932 (UInt32)reltab_j->Type,
1933 reltab_j->VirtualAddress );
1934 printName ( sym->Name, strtab );
1935 fprintf ( stderr, "'\n" ));
1937 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1938 COFF_section* section_sym
1939 = findPEi386SectionCalled ( oc, sym->Name );
1941 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1944 S = ((UInt32)(oc->image))
1945 + (section_sym->PointerToRawData
1948 copyName ( sym->Name, strtab, symbol, 1000-1 );
1949 (void*)S = lookupLocalSymbol( oc, symbol );
1950 if ((void*)S != NULL) goto foundit;
1951 (void*)S = lookupSymbol( symbol );
1952 if ((void*)S != NULL) goto foundit;
1953 zapTrailingAtSign ( symbol );
1954 (void*)S = lookupLocalSymbol( oc, symbol );
1955 if ((void*)S != NULL) goto foundit;
1956 (void*)S = lookupSymbol( symbol );
1957 if ((void*)S != NULL) goto foundit;
1958 /* Newline first because the interactive linker has printed "linking..." */
1959 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1963 checkProddableBlock(oc, pP);
1964 switch (reltab_j->Type) {
1965 case MYIMAGE_REL_I386_DIR32:
1968 case MYIMAGE_REL_I386_REL32:
1969 /* Tricky. We have to insert a displacement at
1970 pP which, when added to the PC for the _next_
1971 insn, gives the address of the target (S).
1972 Problem is to know the address of the next insn
1973 when we only know pP. We assume that this
1974 literal field is always the last in the insn,
1975 so that the address of the next insn is pP+4
1976 -- hence the constant 4.
1977 Also I don't know if A should be added, but so
1978 far it has always been zero.
1981 *pP = S - ((UInt32)pP) - 4;
1984 belch("%s: unhandled PEi386 relocation type %d",
1985 oc->fileName, reltab_j->Type);
1992 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1996 #endif /* defined(OBJFORMAT_PEi386) */
1999 /* --------------------------------------------------------------------------
2001 * ------------------------------------------------------------------------*/
2003 #if defined(OBJFORMAT_ELF)
2008 #if defined(sparc_TARGET_ARCH)
2009 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2010 #elif defined(i386_TARGET_ARCH)
2011 # define ELF_TARGET_386 /* Used inside <elf.h> */
2012 #elif defined(x86_64_TARGET_ARCH)
2013 # define ELF_TARGET_X64_64
2015 #elif defined (ia64_TARGET_ARCH)
2016 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2018 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2019 # define ELF_NEED_GOT /* needs Global Offset Table */
2020 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2023 #if !defined(openbsd_TARGET_OS)
2026 /* openbsd elf has things in different places, with diff names */
2027 #include <elf_abi.h>
2028 #include <machine/reloc.h>
2029 #define R_386_32 RELOC_32
2030 #define R_386_PC32 RELOC_PC32
2034 * Define a set of types which can be used for both ELF32 and ELF64
2038 #define ELFCLASS ELFCLASS64
2039 #define Elf_Addr Elf64_Addr
2040 #define Elf_Word Elf64_Word
2041 #define Elf_Sword Elf64_Sword
2042 #define Elf_Ehdr Elf64_Ehdr
2043 #define Elf_Phdr Elf64_Phdr
2044 #define Elf_Shdr Elf64_Shdr
2045 #define Elf_Sym Elf64_Sym
2046 #define Elf_Rel Elf64_Rel
2047 #define Elf_Rela Elf64_Rela
2048 #define ELF_ST_TYPE ELF64_ST_TYPE
2049 #define ELF_ST_BIND ELF64_ST_BIND
2050 #define ELF_R_TYPE ELF64_R_TYPE
2051 #define ELF_R_SYM ELF64_R_SYM
2053 #define ELFCLASS ELFCLASS32
2054 #define Elf_Addr Elf32_Addr
2055 #define Elf_Word Elf32_Word
2056 #define Elf_Sword Elf32_Sword
2057 #define Elf_Ehdr Elf32_Ehdr
2058 #define Elf_Phdr Elf32_Phdr
2059 #define Elf_Shdr Elf32_Shdr
2060 #define Elf_Sym Elf32_Sym
2061 #define Elf_Rel Elf32_Rel
2062 #define Elf_Rela Elf32_Rela
2064 #define ELF_ST_TYPE ELF32_ST_TYPE
2067 #define ELF_ST_BIND ELF32_ST_BIND
2070 #define ELF_R_TYPE ELF32_R_TYPE
2073 #define ELF_R_SYM ELF32_R_SYM
2079 * Functions to allocate entries in dynamic sections. Currently we simply
2080 * preallocate a large number, and we don't check if a entry for the given
2081 * target already exists (a linear search is too slow). Ideally these
2082 * entries would be associated with symbols.
2085 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2086 #define GOT_SIZE 0x20000
2087 #define FUNCTION_TABLE_SIZE 0x10000
2088 #define PLT_SIZE 0x08000
2091 static Elf_Addr got[GOT_SIZE];
2092 static unsigned int gotIndex;
2093 static Elf_Addr gp_val = (Elf_Addr)got;
2096 allocateGOTEntry(Elf_Addr target)
2100 if (gotIndex >= GOT_SIZE)
2101 barf("Global offset table overflow");
2103 entry = &got[gotIndex++];
2105 return (Elf_Addr)entry;
2109 #ifdef ELF_FUNCTION_DESC
2115 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2116 static unsigned int functionTableIndex;
2119 allocateFunctionDesc(Elf_Addr target)
2121 FunctionDesc *entry;
2123 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2124 barf("Function table overflow");
2126 entry = &functionTable[functionTableIndex++];
2128 entry->gp = (Elf_Addr)gp_val;
2129 return (Elf_Addr)entry;
2133 copyFunctionDesc(Elf_Addr target)
2135 FunctionDesc *olddesc = (FunctionDesc *)target;
2136 FunctionDesc *newdesc;
2138 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2139 newdesc->gp = olddesc->gp;
2140 return (Elf_Addr)newdesc;
2145 #ifdef ia64_TARGET_ARCH
2146 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2147 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2149 static unsigned char plt_code[] =
2151 /* taken from binutils bfd/elfxx-ia64.c */
2152 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2153 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2154 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2155 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2156 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2157 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2160 /* If we can't get to the function descriptor via gp, take a local copy of it */
2161 #define PLT_RELOC(code, target) { \
2162 Elf64_Sxword rel_value = target - gp_val; \
2163 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2164 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2166 ia64_reloc_gprel22((Elf_Addr)code, target); \
2171 unsigned char code[sizeof(plt_code)];
2175 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2177 PLTEntry *plt = (PLTEntry *)oc->plt;
2180 if (oc->pltIndex >= PLT_SIZE)
2181 barf("Procedure table overflow");
2183 entry = &plt[oc->pltIndex++];
2184 memcpy(entry->code, plt_code, sizeof(entry->code));
2185 PLT_RELOC(entry->code, target);
2186 return (Elf_Addr)entry;
2192 return (PLT_SIZE * sizeof(PLTEntry));
2198 * Generic ELF functions
2202 findElfSection ( void* objImage, Elf_Word sh_type )
2204 char* ehdrC = (char*)objImage;
2205 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2206 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2207 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2211 for (i = 0; i < ehdr->e_shnum; i++) {
2212 if (shdr[i].sh_type == sh_type
2213 /* Ignore the section header's string table. */
2214 && i != ehdr->e_shstrndx
2215 /* Ignore string tables named .stabstr, as they contain
2217 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2219 ptr = ehdrC + shdr[i].sh_offset;
2226 #if defined(ia64_TARGET_ARCH)
2228 findElfSegment ( void* objImage, Elf_Addr vaddr )
2230 char* ehdrC = (char*)objImage;
2231 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2232 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2233 Elf_Addr segaddr = 0;
2236 for (i = 0; i < ehdr->e_phnum; i++) {
2237 segaddr = phdr[i].p_vaddr;
2238 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2246 ocVerifyImage_ELF ( ObjectCode* oc )
2250 int i, j, nent, nstrtab, nsymtabs;
2254 char* ehdrC = (char*)(oc->image);
2255 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2257 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2258 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2259 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2260 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2261 belch("%s: not an ELF object", oc->fileName);
2265 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2266 belch("%s: unsupported ELF format", oc->fileName);
2270 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2271 IF_DEBUG(linker,belch( "Is little-endian" ));
2273 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2274 IF_DEBUG(linker,belch( "Is big-endian" ));
2276 belch("%s: unknown endiannness", oc->fileName);
2280 if (ehdr->e_type != ET_REL) {
2281 belch("%s: not a relocatable object (.o) file", oc->fileName);
2284 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2286 IF_DEBUG(linker,belch( "Architecture is " ));
2287 switch (ehdr->e_machine) {
2288 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2289 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2291 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2293 default: IF_DEBUG(linker,belch( "unknown" ));
2294 belch("%s: unknown architecture", oc->fileName);
2298 IF_DEBUG(linker,belch(
2299 "\nSection header table: start %d, n_entries %d, ent_size %d",
2300 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2302 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2304 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2306 if (ehdr->e_shstrndx == SHN_UNDEF) {
2307 belch("%s: no section header string table", oc->fileName);
2310 IF_DEBUG(linker,belch( "Section header string table is section %d",
2312 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2315 for (i = 0; i < ehdr->e_shnum; i++) {
2316 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2317 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2318 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2319 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2320 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2321 ehdrC + shdr[i].sh_offset,
2322 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2324 if (shdr[i].sh_type == SHT_REL) {
2325 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2326 } else if (shdr[i].sh_type == SHT_RELA) {
2327 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2329 IF_DEBUG(linker,fprintf(stderr," "));
2332 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2336 IF_DEBUG(linker,belch( "\nString tables" ));
2339 for (i = 0; i < ehdr->e_shnum; i++) {
2340 if (shdr[i].sh_type == SHT_STRTAB
2341 /* Ignore the section header's string table. */
2342 && i != ehdr->e_shstrndx
2343 /* Ignore string tables named .stabstr, as they contain
2345 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2347 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2348 strtab = ehdrC + shdr[i].sh_offset;
2353 belch("%s: no string tables, or too many", oc->fileName);
2358 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2359 for (i = 0; i < ehdr->e_shnum; i++) {
2360 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2361 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2363 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2364 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2365 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2367 shdr[i].sh_size % sizeof(Elf_Sym)
2369 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2370 belch("%s: non-integral number of symbol table entries", oc->fileName);
2373 for (j = 0; j < nent; j++) {
2374 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2375 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2376 (int)stab[j].st_shndx,
2377 (int)stab[j].st_size,
2378 (char*)stab[j].st_value ));
2380 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2381 switch (ELF_ST_TYPE(stab[j].st_info)) {
2382 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2383 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2384 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2385 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2386 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2387 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2389 IF_DEBUG(linker,fprintf(stderr, " " ));
2391 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2392 switch (ELF_ST_BIND(stab[j].st_info)) {
2393 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2394 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2395 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2396 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2398 IF_DEBUG(linker,fprintf(stderr, " " ));
2400 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2404 if (nsymtabs == 0) {
2405 belch("%s: didn't find any symbol tables", oc->fileName);
2414 ocGetNames_ELF ( ObjectCode* oc )
2419 char* ehdrC = (char*)(oc->image);
2420 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2421 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2422 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2424 ASSERT(symhash != NULL);
2427 belch("%s: no strtab", oc->fileName);
2432 for (i = 0; i < ehdr->e_shnum; i++) {
2433 /* Figure out what kind of section it is. Logic derived from
2434 Figure 1.14 ("Special Sections") of the ELF document
2435 ("Portable Formats Specification, Version 1.1"). */
2436 Elf_Shdr hdr = shdr[i];
2437 SectionKind kind = SECTIONKIND_OTHER;
2440 if (hdr.sh_type == SHT_PROGBITS
2441 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2442 /* .text-style section */
2443 kind = SECTIONKIND_CODE_OR_RODATA;
2446 if (hdr.sh_type == SHT_PROGBITS
2447 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2448 /* .data-style section */
2449 kind = SECTIONKIND_RWDATA;
2452 if (hdr.sh_type == SHT_PROGBITS
2453 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2454 /* .rodata-style section */
2455 kind = SECTIONKIND_CODE_OR_RODATA;
2458 if (hdr.sh_type == SHT_NOBITS
2459 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2460 /* .bss-style section */
2461 kind = SECTIONKIND_RWDATA;
2465 if (is_bss && shdr[i].sh_size > 0) {
2466 /* This is a non-empty .bss section. Allocate zeroed space for
2467 it, and set its .sh_offset field such that
2468 ehdrC + .sh_offset == addr_of_zeroed_space. */
2469 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2470 "ocGetNames_ELF(BSS)");
2471 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2473 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2474 zspace, shdr[i].sh_size);
2478 /* fill in the section info */
2479 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2480 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2481 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2482 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2485 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2487 /* copy stuff into this module's object symbol table */
2488 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2489 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2491 oc->n_symbols = nent;
2492 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2493 "ocGetNames_ELF(oc->symbols)");
2495 for (j = 0; j < nent; j++) {
2497 char isLocal = FALSE; /* avoids uninit-var warning */
2499 char* nm = strtab + stab[j].st_name;
2500 int secno = stab[j].st_shndx;
2502 /* Figure out if we want to add it; if so, set ad to its
2503 address. Otherwise leave ad == NULL. */
2505 if (secno == SHN_COMMON) {
2507 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2509 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2510 stab[j].st_size, nm);
2512 /* Pointless to do addProddableBlock() for this area,
2513 since the linker should never poke around in it. */
2516 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2517 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2519 /* and not an undefined symbol */
2520 && stab[j].st_shndx != SHN_UNDEF
2521 /* and not in a "special section" */
2522 && stab[j].st_shndx < SHN_LORESERVE
2524 /* and it's a not a section or string table or anything silly */
2525 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2526 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2527 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2530 /* Section 0 is the undefined section, hence > and not >=. */
2531 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2533 if (shdr[secno].sh_type == SHT_NOBITS) {
2534 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2535 stab[j].st_size, stab[j].st_value, nm);
2538 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2539 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2542 #ifdef ELF_FUNCTION_DESC
2543 /* dlsym() and the initialisation table both give us function
2544 * descriptors, so to be consistent we store function descriptors
2545 * in the symbol table */
2546 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2547 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2549 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2550 ad, oc->fileName, nm ));
2555 /* And the decision is ... */
2559 oc->symbols[j] = nm;
2562 /* Ignore entirely. */
2564 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2568 IF_DEBUG(linker,belch( "skipping `%s'",
2569 strtab + stab[j].st_name ));
2572 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2573 (int)ELF_ST_BIND(stab[j].st_info),
2574 (int)ELF_ST_TYPE(stab[j].st_info),
2575 (int)stab[j].st_shndx,
2576 strtab + stab[j].st_name
2579 oc->symbols[j] = NULL;
2588 /* Do ELF relocations which lack an explicit addend. All x86-linux
2589 relocations appear to be of this form. */
2591 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2592 Elf_Shdr* shdr, int shnum,
2593 Elf_Sym* stab, char* strtab )
2598 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2599 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2600 int target_shndx = shdr[shnum].sh_info;
2601 int symtab_shndx = shdr[shnum].sh_link;
2603 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2604 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2605 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2606 target_shndx, symtab_shndx ));
2608 for (j = 0; j < nent; j++) {
2609 Elf_Addr offset = rtab[j].r_offset;
2610 Elf_Addr info = rtab[j].r_info;
2612 Elf_Addr P = ((Elf_Addr)targ) + offset;
2613 Elf_Word* pP = (Elf_Word*)P;
2618 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2619 j, (void*)offset, (void*)info ));
2621 IF_DEBUG(linker,belch( " ZERO" ));
2624 Elf_Sym sym = stab[ELF_R_SYM(info)];
2625 /* First see if it is a local symbol. */
2626 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2627 /* Yes, so we can get the address directly from the ELF symbol
2629 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2631 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2632 + stab[ELF_R_SYM(info)].st_value);
2635 /* No, so look up the name in our global table. */
2636 symbol = strtab + sym.st_name;
2637 (void*)S = lookupSymbol( symbol );
2640 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2643 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2646 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2647 (void*)P, (void*)S, (void*)A ));
2648 checkProddableBlock ( oc, pP );
2652 switch (ELF_R_TYPE(info)) {
2653 # ifdef i386_TARGET_ARCH
2654 case R_386_32: *pP = value; break;
2655 case R_386_PC32: *pP = value - P; break;
2658 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2659 oc->fileName, ELF_R_TYPE(info));
2667 /* Do ELF relocations for which explicit addends are supplied.
2668 sparc-solaris relocations appear to be of this form. */
2670 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2671 Elf_Shdr* shdr, int shnum,
2672 Elf_Sym* stab, char* strtab )
2677 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2678 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2679 int target_shndx = shdr[shnum].sh_info;
2680 int symtab_shndx = shdr[shnum].sh_link;
2682 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2683 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2684 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2685 target_shndx, symtab_shndx ));
2687 for (j = 0; j < nent; j++) {
2688 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2689 /* This #ifdef only serves to avoid unused-var warnings. */
2690 Elf_Addr offset = rtab[j].r_offset;
2691 Elf_Addr P = targ + offset;
2693 Elf_Addr info = rtab[j].r_info;
2694 Elf_Addr A = rtab[j].r_addend;
2697 # if defined(sparc_TARGET_ARCH)
2698 Elf_Word* pP = (Elf_Word*)P;
2700 # elif defined(ia64_TARGET_ARCH)
2701 Elf64_Xword *pP = (Elf64_Xword *)P;
2705 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2706 j, (void*)offset, (void*)info,
2709 IF_DEBUG(linker,belch( " ZERO" ));
2712 Elf_Sym sym = stab[ELF_R_SYM(info)];
2713 /* First see if it is a local symbol. */
2714 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2715 /* Yes, so we can get the address directly from the ELF symbol
2717 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2719 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2720 + stab[ELF_R_SYM(info)].st_value);
2721 #ifdef ELF_FUNCTION_DESC
2722 /* Make a function descriptor for this function */
2723 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2724 S = allocateFunctionDesc(S + A);
2729 /* No, so look up the name in our global table. */
2730 symbol = strtab + sym.st_name;
2731 (void*)S = lookupSymbol( symbol );
2733 #ifdef ELF_FUNCTION_DESC
2734 /* If a function, already a function descriptor - we would
2735 have to copy it to add an offset. */
2736 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2737 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2741 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2744 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2747 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2748 (void*)P, (void*)S, (void*)A ));
2749 /* checkProddableBlock ( oc, (void*)P ); */
2753 switch (ELF_R_TYPE(info)) {
2754 # if defined(sparc_TARGET_ARCH)
2755 case R_SPARC_WDISP30:
2756 w1 = *pP & 0xC0000000;
2757 w2 = (Elf_Word)((value - P) >> 2);
2758 ASSERT((w2 & 0xC0000000) == 0);
2763 w1 = *pP & 0xFFC00000;
2764 w2 = (Elf_Word)(value >> 10);
2765 ASSERT((w2 & 0xFFC00000) == 0);
2771 w2 = (Elf_Word)(value & 0x3FF);
2772 ASSERT((w2 & ~0x3FF) == 0);
2776 /* According to the Sun documentation:
2778 This relocation type resembles R_SPARC_32, except it refers to an
2779 unaligned word. That is, the word to be relocated must be treated
2780 as four separate bytes with arbitrary alignment, not as a word
2781 aligned according to the architecture requirements.
2783 (JRS: which means that freeloading on the R_SPARC_32 case
2784 is probably wrong, but hey ...)
2788 w2 = (Elf_Word)value;
2791 # elif defined(ia64_TARGET_ARCH)
2792 case R_IA64_DIR64LSB:
2793 case R_IA64_FPTR64LSB:
2796 case R_IA64_PCREL64LSB:
2799 case R_IA64_SEGREL64LSB:
2800 addr = findElfSegment(ehdrC, value);
2803 case R_IA64_GPREL22:
2804 ia64_reloc_gprel22(P, value);
2806 case R_IA64_LTOFF22:
2807 case R_IA64_LTOFF22X:
2808 case R_IA64_LTOFF_FPTR22:
2809 addr = allocateGOTEntry(value);
2810 ia64_reloc_gprel22(P, addr);
2812 case R_IA64_PCREL21B:
2813 ia64_reloc_pcrel21(P, S, oc);
2816 /* This goes with R_IA64_LTOFF22X and points to the load to
2817 * convert into a move. We don't implement relaxation. */
2821 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2822 oc->fileName, ELF_R_TYPE(info));
2831 ocResolve_ELF ( ObjectCode* oc )
2835 Elf_Sym* stab = NULL;
2836 char* ehdrC = (char*)(oc->image);
2837 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2838 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2839 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2841 /* first find "the" symbol table */
2842 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2844 /* also go find the string table */
2845 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2847 if (stab == NULL || strtab == NULL) {
2848 belch("%s: can't find string or symbol table", oc->fileName);
2852 /* Process the relocation sections. */
2853 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2855 /* Skip sections called ".rel.stab". These appear to contain
2856 relocation entries that, when done, make the stabs debugging
2857 info point at the right places. We ain't interested in all
2859 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2862 if (shdr[shnum].sh_type == SHT_REL ) {
2863 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2864 shnum, stab, strtab );
2868 if (shdr[shnum].sh_type == SHT_RELA) {
2869 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2870 shnum, stab, strtab );
2875 /* Free the local symbol table; we won't need it again. */
2876 freeHashTable(oc->lochash, NULL);
2884 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2885 * at the front. The following utility functions pack and unpack instructions, and
2886 * take care of the most common relocations.
2889 #ifdef ia64_TARGET_ARCH
2892 ia64_extract_instruction(Elf64_Xword *target)
2895 int slot = (Elf_Addr)target & 3;
2896 (Elf_Addr)target &= ~3;
2904 return ((w1 >> 5) & 0x1ffffffffff);
2906 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2910 barf("ia64_extract_instruction: invalid slot %p", target);
2915 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2917 int slot = (Elf_Addr)target & 3;
2918 (Elf_Addr)target &= ~3;
2923 *target |= value << 5;
2926 *target |= value << 46;
2927 *(target+1) |= value >> 18;
2930 *(target+1) |= value << 23;
2936 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2938 Elf64_Xword instruction;
2939 Elf64_Sxword rel_value;
2941 rel_value = value - gp_val;
2942 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2943 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2945 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2946 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2947 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2948 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2949 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2950 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2954 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2956 Elf64_Xword instruction;
2957 Elf64_Sxword rel_value;
2960 entry = allocatePLTEntry(value, oc);
2962 rel_value = (entry >> 4) - (target >> 4);
2963 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2964 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2966 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2967 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2968 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2969 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2976 /* --------------------------------------------------------------------------
2978 * ------------------------------------------------------------------------*/
2980 #if defined(OBJFORMAT_MACHO)
2983 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2984 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2986 I hereby formally apologize for the hackish nature of this code.
2987 Things that need to be done:
2988 *) get common symbols and .bss sections to work properly.
2989 Haskell modules seem to work, but C modules can cause problems
2990 *) implement ocVerifyImage_MachO
2991 *) add more sanity checks. The current code just has to segfault if there's a
2995 static int ocVerifyImage_MachO(ObjectCode* oc)
2997 // FIXME: do some verifying here
3001 static int resolveImports(
3004 struct symtab_command *symLC,
3005 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3006 unsigned long *indirectSyms,
3007 struct nlist *nlist)
3011 for(i=0;i*4<sect->size;i++)
3013 // according to otool, reserved1 contains the first index into the indirect symbol table
3014 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3015 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3018 if((symbol->n_type & N_TYPE) == N_UNDF
3019 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3020 addr = (void*) (symbol->n_value);
3021 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3024 addr = lookupSymbol(nm);
3027 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3031 ((void**)(image + sect->offset))[i] = addr;
3037 static int relocateSection(char *image,
3038 struct symtab_command *symLC, struct nlist *nlist,
3039 struct section* sections, struct section *sect)
3041 struct relocation_info *relocs;
3044 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3046 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3050 relocs = (struct relocation_info*) (image + sect->reloff);
3054 if(relocs[i].r_address & R_SCATTERED)
3056 struct scattered_relocation_info *scat =
3057 (struct scattered_relocation_info*) &relocs[i];
3061 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3063 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3065 *word = scat->r_value + sect->offset + ((long) image);
3069 continue; // FIXME: I hope it's OK to ignore all the others.
3073 struct relocation_info *reloc = &relocs[i];
3074 if(reloc->r_pcrel && !reloc->r_extern)
3077 if(reloc->r_length == 2)
3079 unsigned long word = 0;
3081 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3083 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3087 else if(reloc->r_type == PPC_RELOC_LO16)
3089 word = ((unsigned short*) wordPtr)[1];
3090 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3092 else if(reloc->r_type == PPC_RELOC_HI16)
3094 word = ((unsigned short*) wordPtr)[1] << 16;
3095 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3097 else if(reloc->r_type == PPC_RELOC_HA16)
3099 word = ((unsigned short*) wordPtr)[1] << 16;
3100 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3102 else if(reloc->r_type == PPC_RELOC_BR24)
3105 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3109 if(!reloc->r_extern)
3112 sections[reloc->r_symbolnum-1].offset
3113 - sections[reloc->r_symbolnum-1].addr
3120 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3121 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3122 word = (unsigned long) (lookupSymbol(nm));
3125 belch("\nunknown symbol `%s'", nm);
3130 word -= ((long)image) + sect->offset + reloc->r_address;
3133 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3138 else if(reloc->r_type == PPC_RELOC_LO16)
3140 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3143 else if(reloc->r_type == PPC_RELOC_HI16)
3145 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3148 else if(reloc->r_type == PPC_RELOC_HA16)
3150 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3151 + ((word & (1<<15)) ? 1 : 0);
3154 else if(reloc->r_type == PPC_RELOC_BR24)
3156 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3160 barf("\nunknown relocation %d",reloc->r_type);
3167 static int ocGetNames_MachO(ObjectCode* oc)
3169 char *image = (char*) oc->image;
3170 struct mach_header *header = (struct mach_header*) image;
3171 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3172 unsigned i,curSymbol;
3173 struct segment_command *segLC = NULL;
3174 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3175 struct symtab_command *symLC = NULL;
3176 struct dysymtab_command *dsymLC = NULL;
3177 struct nlist *nlist;
3178 unsigned long commonSize = 0;
3179 char *commonStorage = NULL;
3180 unsigned long commonCounter;
3182 for(i=0;i<header->ncmds;i++)
3184 if(lc->cmd == LC_SEGMENT)
3185 segLC = (struct segment_command*) lc;
3186 else if(lc->cmd == LC_SYMTAB)
3187 symLC = (struct symtab_command*) lc;
3188 else if(lc->cmd == LC_DYSYMTAB)
3189 dsymLC = (struct dysymtab_command*) lc;
3190 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3193 sections = (struct section*) (segLC+1);
3194 nlist = (struct nlist*) (image + symLC->symoff);
3196 for(i=0;i<segLC->nsects;i++)
3198 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3199 la_ptrs = §ions[i];
3200 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3201 nl_ptrs = §ions[i];
3203 // for now, only add __text and __const to the sections table
3204 else if(!strcmp(sections[i].sectname,"__text"))
3205 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3206 (void*) (image + sections[i].offset),
3207 (void*) (image + sections[i].offset + sections[i].size));
3208 else if(!strcmp(sections[i].sectname,"__const"))
3209 addSection(oc, SECTIONKIND_RWDATA,
3210 (void*) (image + sections[i].offset),
3211 (void*) (image + sections[i].offset + sections[i].size));
3212 else if(!strcmp(sections[i].sectname,"__data"))
3213 addSection(oc, SECTIONKIND_RWDATA,
3214 (void*) (image + sections[i].offset),
3215 (void*) (image + sections[i].offset + sections[i].size));
3218 // count external symbols defined here
3220 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3222 if((nlist[i].n_type & N_TYPE) == N_SECT)
3225 for(i=0;i<symLC->nsyms;i++)
3227 if((nlist[i].n_type & N_TYPE) == N_UNDF
3228 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3230 commonSize += nlist[i].n_value;
3234 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3235 "ocGetNames_MachO(oc->symbols)");
3237 // insert symbols into hash table
3238 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3240 if((nlist[i].n_type & N_TYPE) == N_SECT)
3242 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3243 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3244 sections[nlist[i].n_sect-1].offset
3245 - sections[nlist[i].n_sect-1].addr
3246 + nlist[i].n_value);
3247 oc->symbols[curSymbol++] = nm;
3251 // insert local symbols into lochash
3252 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3254 if((nlist[i].n_type & N_TYPE) == N_SECT)
3256 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3257 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3258 sections[nlist[i].n_sect-1].offset
3259 - sections[nlist[i].n_sect-1].addr
3260 + nlist[i].n_value);
3265 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3266 commonCounter = (unsigned long)commonStorage;
3267 for(i=0;i<symLC->nsyms;i++)
3269 if((nlist[i].n_type & N_TYPE) == N_UNDF
3270 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3272 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3273 unsigned long sz = nlist[i].n_value;
3275 nlist[i].n_value = commonCounter;
3277 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3278 oc->symbols[curSymbol++] = nm;
3280 commonCounter += sz;
3286 static int ocResolve_MachO(ObjectCode* oc)
3288 char *image = (char*) oc->image;
3289 struct mach_header *header = (struct mach_header*) image;
3290 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3292 struct segment_command *segLC = NULL;
3293 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3294 struct symtab_command *symLC = NULL;
3295 struct dysymtab_command *dsymLC = NULL;
3296 struct nlist *nlist;
3297 unsigned long *indirectSyms;
3299 for(i=0;i<header->ncmds;i++)
3301 if(lc->cmd == LC_SEGMENT)
3302 segLC = (struct segment_command*) lc;
3303 else if(lc->cmd == LC_SYMTAB)
3304 symLC = (struct symtab_command*) lc;
3305 else if(lc->cmd == LC_DYSYMTAB)
3306 dsymLC = (struct dysymtab_command*) lc;
3307 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3310 sections = (struct section*) (segLC+1);
3311 nlist = (struct nlist*) (image + symLC->symoff);
3313 for(i=0;i<segLC->nsects;i++)
3315 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3316 la_ptrs = §ions[i];
3317 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3318 nl_ptrs = §ions[i];
3321 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3324 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3327 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3330 for(i=0;i<segLC->nsects;i++)
3332 if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
3336 /* Free the local symbol table; we won't need it again. */
3337 freeHashTable(oc->lochash, NULL);
3343 * The Mach-O object format uses leading underscores. But not everywhere.
3344 * There is a small number of runtime support functions defined in
3345 * libcc_dynamic.a whose name does not have a leading underscore.
3346 * As a consequence, we can't get their address from C code.
3347 * We have to use inline assembler just to take the address of a function.
3351 static void machoInitSymbolsWithoutUnderscore()
3357 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3358 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3360 RTS_MACHO_NOUNDERLINE_SYMBOLS