1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.129 2003/09/11 15:12:25 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(isDoubleDenormalized) \
385 SymX(isDoubleInfinite) \
387 SymX(isDoubleNegativeZero) \
388 SymX(isEmptyMVarzh_fast) \
389 SymX(isFloatDenormalized) \
390 SymX(isFloatInfinite) \
392 SymX(isFloatNegativeZero) \
393 SymX(killThreadzh_fast) \
394 SymX(makeStablePtrzh_fast) \
395 SymX(minusIntegerzh_fast) \
396 SymX(mkApUpd0zh_fast) \
397 SymX(myThreadIdzh_fast) \
398 SymX(labelThreadzh_fast) \
399 SymX(newArrayzh_fast) \
400 SymX(newBCOzh_fast) \
401 SymX(newByteArrayzh_fast) \
402 SymX_redirect(newCAF, newDynCAF) \
403 SymX(newMVarzh_fast) \
404 SymX(newMutVarzh_fast) \
405 SymX(atomicModifyMutVarzh_fast) \
406 SymX(newPinnedByteArrayzh_fast) \
407 SymX(orIntegerzh_fast) \
409 SymX(plusIntegerzh_fast) \
412 SymX(putMVarzh_fast) \
413 SymX(quotIntegerzh_fast) \
414 SymX(quotRemIntegerzh_fast) \
416 SymX(raiseIOzh_fast) \
417 SymX(remIntegerzh_fast) \
418 SymX(resetNonBlockingFd) \
421 SymX(rts_checkSchedStatus) \
424 SymX(rts_evalLazyIO) \
428 SymX(rts_getDouble) \
433 SymX(rts_getFunPtr) \
434 SymX(rts_getStablePtr) \
435 SymX(rts_getThreadId) \
437 SymX(rts_getWord32) \
450 SymX(rts_mkStablePtr) \
460 SymX(startupHaskell) \
461 SymX(shutdownHaskell) \
462 SymX(shutdownHaskellAndExit) \
463 SymX(stable_ptr_table) \
464 SymX(stackOverflow) \
465 SymX(stg_CAF_BLACKHOLE_info) \
466 SymX(stg_BLACKHOLE_BQ_info) \
467 SymX(awakenBlockedQueue) \
468 SymX(stg_CHARLIKE_closure) \
469 SymX(stg_EMPTY_MVAR_info) \
470 SymX(stg_IND_STATIC_info) \
471 SymX(stg_INTLIKE_closure) \
472 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
473 SymX(stg_WEAK_info) \
474 SymX(stg_ap_v_info) \
475 SymX(stg_ap_f_info) \
476 SymX(stg_ap_d_info) \
477 SymX(stg_ap_l_info) \
478 SymX(stg_ap_n_info) \
479 SymX(stg_ap_p_info) \
480 SymX(stg_ap_pv_info) \
481 SymX(stg_ap_pp_info) \
482 SymX(stg_ap_ppv_info) \
483 SymX(stg_ap_ppp_info) \
484 SymX(stg_ap_pppp_info) \
485 SymX(stg_ap_ppppp_info) \
486 SymX(stg_ap_pppppp_info) \
487 SymX(stg_ap_ppppppp_info) \
495 SymX(stg_ap_pv_ret) \
496 SymX(stg_ap_pp_ret) \
497 SymX(stg_ap_ppv_ret) \
498 SymX(stg_ap_ppp_ret) \
499 SymX(stg_ap_pppp_ret) \
500 SymX(stg_ap_ppppp_ret) \
501 SymX(stg_ap_pppppp_ret) \
502 SymX(stg_ap_ppppppp_ret) \
503 SymX(stg_ap_1_upd_info) \
504 SymX(stg_ap_2_upd_info) \
505 SymX(stg_ap_3_upd_info) \
506 SymX(stg_ap_4_upd_info) \
507 SymX(stg_ap_5_upd_info) \
508 SymX(stg_ap_6_upd_info) \
509 SymX(stg_ap_7_upd_info) \
510 SymX(stg_ap_8_upd_info) \
512 SymX(stg_sel_0_upd_info) \
513 SymX(stg_sel_10_upd_info) \
514 SymX(stg_sel_11_upd_info) \
515 SymX(stg_sel_12_upd_info) \
516 SymX(stg_sel_13_upd_info) \
517 SymX(stg_sel_14_upd_info) \
518 SymX(stg_sel_15_upd_info) \
519 SymX(stg_sel_1_upd_info) \
520 SymX(stg_sel_2_upd_info) \
521 SymX(stg_sel_3_upd_info) \
522 SymX(stg_sel_4_upd_info) \
523 SymX(stg_sel_5_upd_info) \
524 SymX(stg_sel_6_upd_info) \
525 SymX(stg_sel_7_upd_info) \
526 SymX(stg_sel_8_upd_info) \
527 SymX(stg_sel_9_upd_info) \
528 SymX(stg_upd_frame_info) \
529 SymX(suspendThread) \
530 SymX(takeMVarzh_fast) \
531 SymX(timesIntegerzh_fast) \
532 SymX(tryPutMVarzh_fast) \
533 SymX(tryTakeMVarzh_fast) \
534 SymX(unblockAsyncExceptionszh_fast) \
535 SymX(unsafeThawArrayzh_fast) \
536 SymX(waitReadzh_fast) \
537 SymX(waitWritezh_fast) \
538 SymX(word2Integerzh_fast) \
539 SymX(xorIntegerzh_fast) \
542 #ifdef SUPPORT_LONG_LONGS
543 #define RTS_LONG_LONG_SYMS \
544 SymX(int64ToIntegerzh_fast) \
545 SymX(word64ToIntegerzh_fast)
547 #define RTS_LONG_LONG_SYMS /* nothing */
550 // 64-bit support functions in libgcc.a
551 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
552 #define RTS_LIBGCC_SYMBOLS \
561 #elif defined(ia64_TARGET_ARCH)
562 #define RTS_LIBGCC_SYMBOLS \
570 #define RTS_LIBGCC_SYMBOLS
573 #ifdef darwin_TARGET_OS
574 // Symbols that don't have a leading underscore
575 // on Mac OS X. They have to receive special treatment,
576 // see machoInitSymbolsWithoutUnderscore()
577 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
582 /* entirely bogus claims about types of these symbols */
583 #define Sym(vvv) extern void vvv(void);
584 #define SymX(vvv) /**/
585 #define SymX_redirect(vvv,xxx) /**/
588 RTS_POSIX_ONLY_SYMBOLS
589 RTS_MINGW_ONLY_SYMBOLS
590 RTS_CYGWIN_ONLY_SYMBOLS
596 #ifdef LEADING_UNDERSCORE
597 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
599 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
602 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
604 #define SymX(vvv) Sym(vvv)
606 // SymX_redirect allows us to redirect references to one symbol to
607 // another symbol. See newCAF/newDynCAF for an example.
608 #define SymX_redirect(vvv,xxx) \
609 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
612 static RtsSymbolVal rtsSyms[] = {
615 RTS_POSIX_ONLY_SYMBOLS
616 RTS_MINGW_ONLY_SYMBOLS
617 RTS_CYGWIN_ONLY_SYMBOLS
619 { 0, 0 } /* sentinel */
622 /* -----------------------------------------------------------------------------
623 * Insert symbols into hash tables, checking for duplicates.
625 static void ghciInsertStrHashTable ( char* obj_name,
631 if (lookupHashTable(table, (StgWord)key) == NULL)
633 insertStrHashTable(table, (StgWord)key, data);
638 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
640 "whilst processing object file\n"
642 "This could be caused by:\n"
643 " * Loading two different object files which export the same symbol\n"
644 " * Specifying the same object file twice on the GHCi command line\n"
645 " * An incorrect `package.conf' entry, causing some object to be\n"
647 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
656 /* -----------------------------------------------------------------------------
657 * initialize the object linker
661 static int linker_init_done = 0 ;
663 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
664 static void *dl_prog_handle;
672 /* Make initLinker idempotent, so we can call it
673 before evey relevant operation; that means we
674 don't need to initialise the linker separately */
675 if (linker_init_done == 1) { return; } else {
676 linker_init_done = 1;
679 symhash = allocStrHashTable();
681 /* populate the symbol table with stuff from the RTS */
682 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
683 ghciInsertStrHashTable("(GHCi built-in symbols)",
684 symhash, sym->lbl, sym->addr);
686 # if defined(OBJFORMAT_MACHO)
687 machoInitSymbolsWithoutUnderscore();
690 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
691 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
695 /* -----------------------------------------------------------------------------
696 * Loading DLL or .so dynamic libraries
697 * -----------------------------------------------------------------------------
699 * Add a DLL from which symbols may be found. In the ELF case, just
700 * do RTLD_GLOBAL-style add, so no further messing around needs to
701 * happen in order that symbols in the loaded .so are findable --
702 * lookupSymbol() will subsequently see them by dlsym on the program's
703 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
705 * In the PEi386 case, open the DLLs and put handles to them in a
706 * linked list. When looking for a symbol, try all handles in the
707 * list. This means that we need to load even DLLs that are guaranteed
708 * to be in the ghc.exe image already, just so we can get a handle
709 * to give to loadSymbol, so that we can find the symbols. For such
710 * libraries, the LoadLibrary call should be a no-op except for returning
715 #if defined(OBJFORMAT_PEi386)
716 /* A record for storing handles into DLLs. */
721 struct _OpenedDLL* next;
726 /* A list thereof. */
727 static OpenedDLL* opened_dlls = NULL;
731 addDLL( char *dll_name )
733 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
734 /* ------------------- ELF DLL loader ------------------- */
740 #if !defined(openbsd_TARGET_OS)
741 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
743 hdl= dlopen(dll_name, RTLD_LAZY);
746 /* dlopen failed; return a ptr to the error msg. */
748 if (errmsg == NULL) errmsg = "addDLL: unknown error";
755 # elif defined(OBJFORMAT_PEi386)
756 /* ------------------- Win32 DLL loader ------------------- */
764 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
766 /* See if we've already got it, and ignore if so. */
767 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
768 if (0 == strcmp(o_dll->name, dll_name))
772 /* The file name has no suffix (yet) so that we can try
773 both foo.dll and foo.drv
775 The documentation for LoadLibrary says:
776 If no file name extension is specified in the lpFileName
777 parameter, the default library extension .dll is
778 appended. However, the file name string can include a trailing
779 point character (.) to indicate that the module name has no
782 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
783 sprintf(buf, "%s.DLL", dll_name);
784 instance = LoadLibrary(buf);
785 if (instance == NULL) {
786 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
787 instance = LoadLibrary(buf);
788 if (instance == NULL) {
791 /* LoadLibrary failed; return a ptr to the error msg. */
792 return "addDLL: unknown error";
797 /* Add this DLL to the list of DLLs in which to search for symbols. */
798 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
799 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
800 strcpy(o_dll->name, dll_name);
801 o_dll->instance = instance;
802 o_dll->next = opened_dlls;
807 barf("addDLL: not implemented on this platform");
811 /* -----------------------------------------------------------------------------
812 * lookup a symbol in the hash table
815 lookupSymbol( char *lbl )
819 ASSERT(symhash != NULL);
820 val = lookupStrHashTable(symhash, lbl);
823 # if defined(OBJFORMAT_ELF)
824 return dlsym(dl_prog_handle, lbl);
825 # elif defined(OBJFORMAT_MACHO)
826 if(NSIsSymbolNameDefined(lbl)) {
827 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
828 return NSAddressOfSymbol(symbol);
832 # elif defined(OBJFORMAT_PEi386)
835 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
836 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
838 /* HACK: if the name has an initial underscore, try stripping
839 it off & look that up first. I've yet to verify whether there's
840 a Rule that governs whether an initial '_' *should always* be
841 stripped off when mapping from import lib name to the DLL name.
843 sym = GetProcAddress(o_dll->instance, (lbl+1));
845 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
849 sym = GetProcAddress(o_dll->instance, lbl);
851 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
866 __attribute((unused))
868 lookupLocalSymbol( ObjectCode* oc, char *lbl )
872 val = lookupStrHashTable(oc->lochash, lbl);
882 /* -----------------------------------------------------------------------------
883 * Debugging aid: look in GHCi's object symbol tables for symbols
884 * within DELTA bytes of the specified address, and show their names.
887 void ghci_enquire ( char* addr );
889 void ghci_enquire ( char* addr )
894 const int DELTA = 64;
899 for (oc = objects; oc; oc = oc->next) {
900 for (i = 0; i < oc->n_symbols; i++) {
901 sym = oc->symbols[i];
902 if (sym == NULL) continue;
903 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
905 if (oc->lochash != NULL) {
906 a = lookupStrHashTable(oc->lochash, sym);
909 a = lookupStrHashTable(symhash, sym);
912 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
914 else if (addr-DELTA <= a && a <= addr+DELTA) {
915 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
922 #ifdef ia64_TARGET_ARCH
923 static unsigned int PLTSize(void);
926 /* -----------------------------------------------------------------------------
927 * Load an obj (populate the global symbol table, but don't resolve yet)
929 * Returns: 1 if ok, 0 on error.
932 loadObj( char *path )
946 /* fprintf(stderr, "loadObj %s\n", path ); */
948 /* Check that we haven't already loaded this object. Don't give up
949 at this stage; ocGetNames_* will barf later. */
953 for (o = objects; o; o = o->next) {
954 if (0 == strcmp(o->fileName, path))
960 "GHCi runtime linker: warning: looks like you're trying to load the\n"
961 "same object file twice:\n"
963 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
969 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
971 # if defined(OBJFORMAT_ELF)
972 oc->formatName = "ELF";
973 # elif defined(OBJFORMAT_PEi386)
974 oc->formatName = "PEi386";
975 # elif defined(OBJFORMAT_MACHO)
976 oc->formatName = "Mach-O";
979 barf("loadObj: not implemented on this platform");
983 if (r == -1) { return 0; }
985 /* sigh, strdup() isn't a POSIX function, so do it the long way */
986 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
987 strcpy(oc->fileName, path);
989 oc->fileSize = st.st_size;
992 oc->lochash = allocStrHashTable();
993 oc->proddables = NULL;
995 /* chain it onto the list of objects */
1000 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1002 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1004 fd = open(path, O_RDONLY);
1006 barf("loadObj: can't open `%s'", path);
1008 pagesize = getpagesize();
1010 #ifdef ia64_TARGET_ARCH
1011 /* The PLT needs to be right before the object */
1012 n = ROUND_UP(PLTSize(), pagesize);
1013 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1014 if (oc->plt == MAP_FAILED)
1015 barf("loadObj: can't allocate PLT");
1018 map_addr = oc->plt + n;
1021 n = ROUND_UP(oc->fileSize, pagesize);
1022 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1023 if (oc->image == MAP_FAILED)
1024 barf("loadObj: can't map `%s'", path);
1028 #else /* !USE_MMAP */
1030 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1032 /* load the image into memory */
1033 f = fopen(path, "rb");
1035 barf("loadObj: can't read `%s'", path);
1037 n = fread ( oc->image, 1, oc->fileSize, f );
1038 if (n != oc->fileSize)
1039 barf("loadObj: error whilst reading `%s'", path);
1043 #endif /* USE_MMAP */
1045 /* verify the in-memory image */
1046 # if defined(OBJFORMAT_ELF)
1047 r = ocVerifyImage_ELF ( oc );
1048 # elif defined(OBJFORMAT_PEi386)
1049 r = ocVerifyImage_PEi386 ( oc );
1050 # elif defined(OBJFORMAT_MACHO)
1051 r = ocVerifyImage_MachO ( oc );
1053 barf("loadObj: no verify method");
1055 if (!r) { return r; }
1057 /* build the symbol list for this image */
1058 # if defined(OBJFORMAT_ELF)
1059 r = ocGetNames_ELF ( oc );
1060 # elif defined(OBJFORMAT_PEi386)
1061 r = ocGetNames_PEi386 ( oc );
1062 # elif defined(OBJFORMAT_MACHO)
1063 r = ocGetNames_MachO ( oc );
1065 barf("loadObj: no getNames method");
1067 if (!r) { return r; }
1069 /* loaded, but not resolved yet */
1070 oc->status = OBJECT_LOADED;
1075 /* -----------------------------------------------------------------------------
1076 * resolve all the currently unlinked objects in memory
1078 * Returns: 1 if ok, 0 on error.
1088 for (oc = objects; oc; oc = oc->next) {
1089 if (oc->status != OBJECT_RESOLVED) {
1090 # if defined(OBJFORMAT_ELF)
1091 r = ocResolve_ELF ( oc );
1092 # elif defined(OBJFORMAT_PEi386)
1093 r = ocResolve_PEi386 ( oc );
1094 # elif defined(OBJFORMAT_MACHO)
1095 r = ocResolve_MachO ( oc );
1097 barf("resolveObjs: not implemented on this platform");
1099 if (!r) { return r; }
1100 oc->status = OBJECT_RESOLVED;
1106 /* -----------------------------------------------------------------------------
1107 * delete an object from the pool
1110 unloadObj( char *path )
1112 ObjectCode *oc, *prev;
1114 ASSERT(symhash != NULL);
1115 ASSERT(objects != NULL);
1120 for (oc = objects; oc; prev = oc, oc = oc->next) {
1121 if (!strcmp(oc->fileName,path)) {
1123 /* Remove all the mappings for the symbols within this
1128 for (i = 0; i < oc->n_symbols; i++) {
1129 if (oc->symbols[i] != NULL) {
1130 removeStrHashTable(symhash, oc->symbols[i], NULL);
1138 prev->next = oc->next;
1141 /* We're going to leave this in place, in case there are
1142 any pointers from the heap into it: */
1143 /* stgFree(oc->image); */
1144 stgFree(oc->fileName);
1145 stgFree(oc->symbols);
1146 stgFree(oc->sections);
1147 /* The local hash table should have been freed at the end
1148 of the ocResolve_ call on it. */
1149 ASSERT(oc->lochash == NULL);
1155 belch("unloadObj: can't find `%s' to unload", path);
1159 /* -----------------------------------------------------------------------------
1160 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1161 * which may be prodded during relocation, and abort if we try and write
1162 * outside any of these.
1164 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1167 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1168 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1172 pb->next = oc->proddables;
1173 oc->proddables = pb;
1176 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1179 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1180 char* s = (char*)(pb->start);
1181 char* e = s + pb->size - 1;
1182 char* a = (char*)addr;
1183 /* Assumes that the biggest fixup involves a 4-byte write. This
1184 probably needs to be changed to 8 (ie, +7) on 64-bit
1186 if (a >= s && (a+3) <= e) return;
1188 barf("checkProddableBlock: invalid fixup in runtime linker");
1191 /* -----------------------------------------------------------------------------
1192 * Section management.
1194 static void addSection ( ObjectCode* oc, SectionKind kind,
1195 void* start, void* end )
1197 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1201 s->next = oc->sections;
1204 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1205 start, ((char*)end)-1, end - start + 1, kind );
1211 /* --------------------------------------------------------------------------
1212 * PEi386 specifics (Win32 targets)
1213 * ------------------------------------------------------------------------*/
1215 /* The information for this linker comes from
1216 Microsoft Portable Executable
1217 and Common Object File Format Specification
1218 revision 5.1 January 1998
1219 which SimonM says comes from the MS Developer Network CDs.
1221 It can be found there (on older CDs), but can also be found
1224 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1226 (this is Rev 6.0 from February 1999).
1228 Things move, so if that fails, try searching for it via
1230 http://www.google.com/search?q=PE+COFF+specification
1232 The ultimate reference for the PE format is the Winnt.h
1233 header file that comes with the Platform SDKs; as always,
1234 implementations will drift wrt their documentation.
1236 A good background article on the PE format is Matt Pietrek's
1237 March 1994 article in Microsoft System Journal (MSJ)
1238 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1239 Win32 Portable Executable File Format." The info in there
1240 has recently been updated in a two part article in
1241 MSDN magazine, issues Feb and March 2002,
1242 "Inside Windows: An In-Depth Look into the Win32 Portable
1243 Executable File Format"
1245 John Levine's book "Linkers and Loaders" contains useful
1250 #if defined(OBJFORMAT_PEi386)
1254 typedef unsigned char UChar;
1255 typedef unsigned short UInt16;
1256 typedef unsigned int UInt32;
1263 UInt16 NumberOfSections;
1264 UInt32 TimeDateStamp;
1265 UInt32 PointerToSymbolTable;
1266 UInt32 NumberOfSymbols;
1267 UInt16 SizeOfOptionalHeader;
1268 UInt16 Characteristics;
1272 #define sizeof_COFF_header 20
1279 UInt32 VirtualAddress;
1280 UInt32 SizeOfRawData;
1281 UInt32 PointerToRawData;
1282 UInt32 PointerToRelocations;
1283 UInt32 PointerToLinenumbers;
1284 UInt16 NumberOfRelocations;
1285 UInt16 NumberOfLineNumbers;
1286 UInt32 Characteristics;
1290 #define sizeof_COFF_section 40
1297 UInt16 SectionNumber;
1300 UChar NumberOfAuxSymbols;
1304 #define sizeof_COFF_symbol 18
1309 UInt32 VirtualAddress;
1310 UInt32 SymbolTableIndex;
1315 #define sizeof_COFF_reloc 10
1318 /* From PE spec doc, section 3.3.2 */
1319 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1320 windows.h -- for the same purpose, but I want to know what I'm
1322 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1323 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1324 #define MYIMAGE_FILE_DLL 0x2000
1325 #define MYIMAGE_FILE_SYSTEM 0x1000
1326 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1327 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1328 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1330 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1331 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1332 #define MYIMAGE_SYM_CLASS_STATIC 3
1333 #define MYIMAGE_SYM_UNDEFINED 0
1335 /* From PE spec doc, section 4.1 */
1336 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1337 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1338 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1340 /* From PE spec doc, section 5.2.1 */
1341 #define MYIMAGE_REL_I386_DIR32 0x0006
1342 #define MYIMAGE_REL_I386_REL32 0x0014
1345 /* We use myindex to calculate array addresses, rather than
1346 simply doing the normal subscript thing. That's because
1347 some of the above structs have sizes which are not
1348 a whole number of words. GCC rounds their sizes up to a
1349 whole number of words, which means that the address calcs
1350 arising from using normal C indexing or pointer arithmetic
1351 are just plain wrong. Sigh.
1354 myindex ( int scale, void* base, int index )
1357 ((UChar*)base) + scale * index;
1362 printName ( UChar* name, UChar* strtab )
1364 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1365 UInt32 strtab_offset = * (UInt32*)(name+4);
1366 fprintf ( stderr, "%s", strtab + strtab_offset );
1369 for (i = 0; i < 8; i++) {
1370 if (name[i] == 0) break;
1371 fprintf ( stderr, "%c", name[i] );
1378 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1380 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1381 UInt32 strtab_offset = * (UInt32*)(name+4);
1382 strncpy ( dst, strtab+strtab_offset, dstSize );
1388 if (name[i] == 0) break;
1398 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1401 /* If the string is longer than 8 bytes, look in the
1402 string table for it -- this will be correctly zero terminated.
1404 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1405 UInt32 strtab_offset = * (UInt32*)(name+4);
1406 return ((UChar*)strtab) + strtab_offset;
1408 /* Otherwise, if shorter than 8 bytes, return the original,
1409 which by defn is correctly terminated.
1411 if (name[7]==0) return name;
1412 /* The annoying case: 8 bytes. Copy into a temporary
1413 (which is never freed ...)
1415 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1417 strncpy(newstr,name,8);
1423 /* Just compares the short names (first 8 chars) */
1424 static COFF_section *
1425 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1429 = (COFF_header*)(oc->image);
1430 COFF_section* sectab
1432 ((UChar*)(oc->image))
1433 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1435 for (i = 0; i < hdr->NumberOfSections; i++) {
1438 COFF_section* section_i
1440 myindex ( sizeof_COFF_section, sectab, i );
1441 n1 = (UChar*) &(section_i->Name);
1443 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1444 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1445 n1[6]==n2[6] && n1[7]==n2[7])
1454 zapTrailingAtSign ( UChar* sym )
1456 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1458 if (sym[0] == 0) return;
1460 while (sym[i] != 0) i++;
1463 while (j > 0 && my_isdigit(sym[j])) j--;
1464 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1470 ocVerifyImage_PEi386 ( ObjectCode* oc )
1475 COFF_section* sectab;
1476 COFF_symbol* symtab;
1478 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1479 hdr = (COFF_header*)(oc->image);
1480 sectab = (COFF_section*) (
1481 ((UChar*)(oc->image))
1482 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1484 symtab = (COFF_symbol*) (
1485 ((UChar*)(oc->image))
1486 + hdr->PointerToSymbolTable
1488 strtab = ((UChar*)symtab)
1489 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1491 if (hdr->Machine != 0x14c) {
1492 belch("Not x86 PEi386");
1495 if (hdr->SizeOfOptionalHeader != 0) {
1496 belch("PEi386 with nonempty optional header");
1499 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1500 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1501 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1502 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1503 belch("Not a PEi386 object file");
1506 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1507 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1508 belch("Invalid PEi386 word size or endiannness: %d",
1509 (int)(hdr->Characteristics));
1512 /* If the string table size is way crazy, this might indicate that
1513 there are more than 64k relocations, despite claims to the
1514 contrary. Hence this test. */
1515 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1517 if ( (*(UInt32*)strtab) > 600000 ) {
1518 /* Note that 600k has no special significance other than being
1519 big enough to handle the almost-2MB-sized lumps that
1520 constitute HSwin32*.o. */
1521 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1526 /* No further verification after this point; only debug printing. */
1528 IF_DEBUG(linker, i=1);
1529 if (i == 0) return 1;
1532 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1534 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1536 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1538 fprintf ( stderr, "\n" );
1540 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1542 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1544 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1546 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1548 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1550 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1552 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1554 /* Print the section table. */
1555 fprintf ( stderr, "\n" );
1556 for (i = 0; i < hdr->NumberOfSections; i++) {
1558 COFF_section* sectab_i
1560 myindex ( sizeof_COFF_section, sectab, i );
1567 printName ( sectab_i->Name, strtab );
1577 sectab_i->VirtualSize,
1578 sectab_i->VirtualAddress,
1579 sectab_i->SizeOfRawData,
1580 sectab_i->PointerToRawData,
1581 sectab_i->NumberOfRelocations,
1582 sectab_i->PointerToRelocations,
1583 sectab_i->PointerToRawData
1585 reltab = (COFF_reloc*) (
1586 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1589 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1590 /* If the relocation field (a short) has overflowed, the
1591 * real count can be found in the first reloc entry.
1593 * See Section 4.1 (last para) of the PE spec (rev6.0).
1595 COFF_reloc* rel = (COFF_reloc*)
1596 myindex ( sizeof_COFF_reloc, reltab, 0 );
1597 noRelocs = rel->VirtualAddress;
1600 noRelocs = sectab_i->NumberOfRelocations;
1604 for (; j < noRelocs; j++) {
1606 COFF_reloc* rel = (COFF_reloc*)
1607 myindex ( sizeof_COFF_reloc, reltab, j );
1609 " type 0x%-4x vaddr 0x%-8x name `",
1611 rel->VirtualAddress );
1612 sym = (COFF_symbol*)
1613 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1614 /* Hmm..mysterious looking offset - what's it for? SOF */
1615 printName ( sym->Name, strtab -10 );
1616 fprintf ( stderr, "'\n" );
1619 fprintf ( stderr, "\n" );
1621 fprintf ( stderr, "\n" );
1622 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1623 fprintf ( stderr, "---START of string table---\n");
1624 for (i = 4; i < *(Int32*)strtab; i++) {
1626 fprintf ( stderr, "\n"); else
1627 fprintf( stderr, "%c", strtab[i] );
1629 fprintf ( stderr, "--- END of string table---\n");
1631 fprintf ( stderr, "\n" );
1634 COFF_symbol* symtab_i;
1635 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1636 symtab_i = (COFF_symbol*)
1637 myindex ( sizeof_COFF_symbol, symtab, i );
1643 printName ( symtab_i->Name, strtab );
1652 (Int32)(symtab_i->SectionNumber),
1653 (UInt32)symtab_i->Type,
1654 (UInt32)symtab_i->StorageClass,
1655 (UInt32)symtab_i->NumberOfAuxSymbols
1657 i += symtab_i->NumberOfAuxSymbols;
1661 fprintf ( stderr, "\n" );
1667 ocGetNames_PEi386 ( ObjectCode* oc )
1670 COFF_section* sectab;
1671 COFF_symbol* symtab;
1678 hdr = (COFF_header*)(oc->image);
1679 sectab = (COFF_section*) (
1680 ((UChar*)(oc->image))
1681 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1683 symtab = (COFF_symbol*) (
1684 ((UChar*)(oc->image))
1685 + hdr->PointerToSymbolTable
1687 strtab = ((UChar*)(oc->image))
1688 + hdr->PointerToSymbolTable
1689 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1691 /* Allocate space for any (local, anonymous) .bss sections. */
1693 for (i = 0; i < hdr->NumberOfSections; i++) {
1695 COFF_section* sectab_i
1697 myindex ( sizeof_COFF_section, sectab, i );
1698 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1699 if (sectab_i->VirtualSize == 0) continue;
1700 /* This is a non-empty .bss section. Allocate zeroed space for
1701 it, and set its PointerToRawData field such that oc->image +
1702 PointerToRawData == addr_of_zeroed_space. */
1703 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1704 "ocGetNames_PEi386(anonymous bss)");
1705 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1706 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1707 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1710 /* Copy section information into the ObjectCode. */
1712 for (i = 0; i < hdr->NumberOfSections; i++) {
1718 = SECTIONKIND_OTHER;
1719 COFF_section* sectab_i
1721 myindex ( sizeof_COFF_section, sectab, i );
1722 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1725 /* I'm sure this is the Right Way to do it. However, the
1726 alternative of testing the sectab_i->Name field seems to
1727 work ok with Cygwin.
1729 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1730 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1731 kind = SECTIONKIND_CODE_OR_RODATA;
1734 if (0==strcmp(".text",sectab_i->Name) ||
1735 0==strcmp(".rodata",sectab_i->Name))
1736 kind = SECTIONKIND_CODE_OR_RODATA;
1737 if (0==strcmp(".data",sectab_i->Name) ||
1738 0==strcmp(".bss",sectab_i->Name))
1739 kind = SECTIONKIND_RWDATA;
1741 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1742 sz = sectab_i->SizeOfRawData;
1743 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1745 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1746 end = start + sz - 1;
1748 if (kind == SECTIONKIND_OTHER
1749 /* Ignore sections called which contain stabs debugging
1751 && 0 != strcmp(".stab", sectab_i->Name)
1752 && 0 != strcmp(".stabstr", sectab_i->Name)
1754 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1758 if (kind != SECTIONKIND_OTHER && end >= start) {
1759 addSection(oc, kind, start, end);
1760 addProddableBlock(oc, start, end - start + 1);
1764 /* Copy exported symbols into the ObjectCode. */
1766 oc->n_symbols = hdr->NumberOfSymbols;
1767 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1768 "ocGetNames_PEi386(oc->symbols)");
1769 /* Call me paranoid; I don't care. */
1770 for (i = 0; i < oc->n_symbols; i++)
1771 oc->symbols[i] = NULL;
1775 COFF_symbol* symtab_i;
1776 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1777 symtab_i = (COFF_symbol*)
1778 myindex ( sizeof_COFF_symbol, symtab, i );
1782 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1783 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1784 /* This symbol is global and defined, viz, exported */
1785 /* for MYIMAGE_SYMCLASS_EXTERNAL
1786 && !MYIMAGE_SYM_UNDEFINED,
1787 the address of the symbol is:
1788 address of relevant section + offset in section
1790 COFF_section* sectabent
1791 = (COFF_section*) myindex ( sizeof_COFF_section,
1793 symtab_i->SectionNumber-1 );
1794 addr = ((UChar*)(oc->image))
1795 + (sectabent->PointerToRawData
1799 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1800 && symtab_i->Value > 0) {
1801 /* This symbol isn't in any section at all, ie, global bss.
1802 Allocate zeroed space for it. */
1803 addr = stgCallocBytes(1, symtab_i->Value,
1804 "ocGetNames_PEi386(non-anonymous bss)");
1805 addSection(oc, SECTIONKIND_RWDATA, addr,
1806 ((UChar*)addr) + symtab_i->Value - 1);
1807 addProddableBlock(oc, addr, symtab_i->Value);
1808 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1811 if (addr != NULL ) {
1812 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1813 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1814 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1815 ASSERT(i >= 0 && i < oc->n_symbols);
1816 /* cstring_from_COFF_symbol_name always succeeds. */
1817 oc->symbols[i] = sname;
1818 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1822 "IGNORING symbol %d\n"
1826 printName ( symtab_i->Name, strtab );
1835 (Int32)(symtab_i->SectionNumber),
1836 (UInt32)symtab_i->Type,
1837 (UInt32)symtab_i->StorageClass,
1838 (UInt32)symtab_i->NumberOfAuxSymbols
1843 i += symtab_i->NumberOfAuxSymbols;
1852 ocResolve_PEi386 ( ObjectCode* oc )
1855 COFF_section* sectab;
1856 COFF_symbol* symtab;
1866 /* ToDo: should be variable-sized? But is at least safe in the
1867 sense of buffer-overrun-proof. */
1869 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1871 hdr = (COFF_header*)(oc->image);
1872 sectab = (COFF_section*) (
1873 ((UChar*)(oc->image))
1874 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1876 symtab = (COFF_symbol*) (
1877 ((UChar*)(oc->image))
1878 + hdr->PointerToSymbolTable
1880 strtab = ((UChar*)(oc->image))
1881 + hdr->PointerToSymbolTable
1882 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1884 for (i = 0; i < hdr->NumberOfSections; i++) {
1885 COFF_section* sectab_i
1887 myindex ( sizeof_COFF_section, sectab, i );
1890 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1893 /* Ignore sections called which contain stabs debugging
1895 if (0 == strcmp(".stab", sectab_i->Name)
1896 || 0 == strcmp(".stabstr", sectab_i->Name))
1899 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1900 /* If the relocation field (a short) has overflowed, the
1901 * real count can be found in the first reloc entry.
1903 * See Section 4.1 (last para) of the PE spec (rev6.0).
1905 COFF_reloc* rel = (COFF_reloc*)
1906 myindex ( sizeof_COFF_reloc, reltab, 0 );
1907 noRelocs = rel->VirtualAddress;
1908 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1911 noRelocs = sectab_i->NumberOfRelocations;
1916 for (; j < noRelocs; j++) {
1918 COFF_reloc* reltab_j
1920 myindex ( sizeof_COFF_reloc, reltab, j );
1922 /* the location to patch */
1924 ((UChar*)(oc->image))
1925 + (sectab_i->PointerToRawData
1926 + reltab_j->VirtualAddress
1927 - sectab_i->VirtualAddress )
1929 /* the existing contents of pP */
1931 /* the symbol to connect to */
1932 sym = (COFF_symbol*)
1933 myindex ( sizeof_COFF_symbol,
1934 symtab, reltab_j->SymbolTableIndex );
1937 "reloc sec %2d num %3d: type 0x%-4x "
1938 "vaddr 0x%-8x name `",
1940 (UInt32)reltab_j->Type,
1941 reltab_j->VirtualAddress );
1942 printName ( sym->Name, strtab );
1943 fprintf ( stderr, "'\n" ));
1945 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1946 COFF_section* section_sym
1947 = findPEi386SectionCalled ( oc, sym->Name );
1949 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1952 S = ((UInt32)(oc->image))
1953 + (section_sym->PointerToRawData
1956 copyName ( sym->Name, strtab, symbol, 1000-1 );
1957 (void*)S = lookupLocalSymbol( oc, symbol );
1958 if ((void*)S != NULL) goto foundit;
1959 (void*)S = lookupSymbol( symbol );
1960 if ((void*)S != NULL) goto foundit;
1961 zapTrailingAtSign ( symbol );
1962 (void*)S = lookupLocalSymbol( oc, symbol );
1963 if ((void*)S != NULL) goto foundit;
1964 (void*)S = lookupSymbol( symbol );
1965 if ((void*)S != NULL) goto foundit;
1966 /* Newline first because the interactive linker has printed "linking..." */
1967 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1971 checkProddableBlock(oc, pP);
1972 switch (reltab_j->Type) {
1973 case MYIMAGE_REL_I386_DIR32:
1976 case MYIMAGE_REL_I386_REL32:
1977 /* Tricky. We have to insert a displacement at
1978 pP which, when added to the PC for the _next_
1979 insn, gives the address of the target (S).
1980 Problem is to know the address of the next insn
1981 when we only know pP. We assume that this
1982 literal field is always the last in the insn,
1983 so that the address of the next insn is pP+4
1984 -- hence the constant 4.
1985 Also I don't know if A should be added, but so
1986 far it has always been zero.
1989 *pP = S - ((UInt32)pP) - 4;
1992 belch("%s: unhandled PEi386 relocation type %d",
1993 oc->fileName, reltab_j->Type);
2000 IF_DEBUG(linker, belch("completed %s", oc->fileName));
2004 #endif /* defined(OBJFORMAT_PEi386) */
2007 /* --------------------------------------------------------------------------
2009 * ------------------------------------------------------------------------*/
2011 #if defined(OBJFORMAT_ELF)
2016 #if defined(sparc_TARGET_ARCH)
2017 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2018 #elif defined(i386_TARGET_ARCH)
2019 # define ELF_TARGET_386 /* Used inside <elf.h> */
2020 #elif defined(x86_64_TARGET_ARCH)
2021 # define ELF_TARGET_X64_64
2023 #elif defined (ia64_TARGET_ARCH)
2024 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2026 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2027 # define ELF_NEED_GOT /* needs Global Offset Table */
2028 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2031 #if !defined(openbsd_TARGET_OS)
2034 /* openbsd elf has things in different places, with diff names */
2035 #include <elf_abi.h>
2036 #include <machine/reloc.h>
2037 #define R_386_32 RELOC_32
2038 #define R_386_PC32 RELOC_PC32
2042 * Define a set of types which can be used for both ELF32 and ELF64
2046 #define ELFCLASS ELFCLASS64
2047 #define Elf_Addr Elf64_Addr
2048 #define Elf_Word Elf64_Word
2049 #define Elf_Sword Elf64_Sword
2050 #define Elf_Ehdr Elf64_Ehdr
2051 #define Elf_Phdr Elf64_Phdr
2052 #define Elf_Shdr Elf64_Shdr
2053 #define Elf_Sym Elf64_Sym
2054 #define Elf_Rel Elf64_Rel
2055 #define Elf_Rela Elf64_Rela
2056 #define ELF_ST_TYPE ELF64_ST_TYPE
2057 #define ELF_ST_BIND ELF64_ST_BIND
2058 #define ELF_R_TYPE ELF64_R_TYPE
2059 #define ELF_R_SYM ELF64_R_SYM
2061 #define ELFCLASS ELFCLASS32
2062 #define Elf_Addr Elf32_Addr
2063 #define Elf_Word Elf32_Word
2064 #define Elf_Sword Elf32_Sword
2065 #define Elf_Ehdr Elf32_Ehdr
2066 #define Elf_Phdr Elf32_Phdr
2067 #define Elf_Shdr Elf32_Shdr
2068 #define Elf_Sym Elf32_Sym
2069 #define Elf_Rel Elf32_Rel
2070 #define Elf_Rela Elf32_Rela
2072 #define ELF_ST_TYPE ELF32_ST_TYPE
2075 #define ELF_ST_BIND ELF32_ST_BIND
2078 #define ELF_R_TYPE ELF32_R_TYPE
2081 #define ELF_R_SYM ELF32_R_SYM
2087 * Functions to allocate entries in dynamic sections. Currently we simply
2088 * preallocate a large number, and we don't check if a entry for the given
2089 * target already exists (a linear search is too slow). Ideally these
2090 * entries would be associated with symbols.
2093 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2094 #define GOT_SIZE 0x20000
2095 #define FUNCTION_TABLE_SIZE 0x10000
2096 #define PLT_SIZE 0x08000
2099 static Elf_Addr got[GOT_SIZE];
2100 static unsigned int gotIndex;
2101 static Elf_Addr gp_val = (Elf_Addr)got;
2104 allocateGOTEntry(Elf_Addr target)
2108 if (gotIndex >= GOT_SIZE)
2109 barf("Global offset table overflow");
2111 entry = &got[gotIndex++];
2113 return (Elf_Addr)entry;
2117 #ifdef ELF_FUNCTION_DESC
2123 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2124 static unsigned int functionTableIndex;
2127 allocateFunctionDesc(Elf_Addr target)
2129 FunctionDesc *entry;
2131 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2132 barf("Function table overflow");
2134 entry = &functionTable[functionTableIndex++];
2136 entry->gp = (Elf_Addr)gp_val;
2137 return (Elf_Addr)entry;
2141 copyFunctionDesc(Elf_Addr target)
2143 FunctionDesc *olddesc = (FunctionDesc *)target;
2144 FunctionDesc *newdesc;
2146 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2147 newdesc->gp = olddesc->gp;
2148 return (Elf_Addr)newdesc;
2153 #ifdef ia64_TARGET_ARCH
2154 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2155 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2157 static unsigned char plt_code[] =
2159 /* taken from binutils bfd/elfxx-ia64.c */
2160 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2161 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2162 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2163 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2164 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2165 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2168 /* If we can't get to the function descriptor via gp, take a local copy of it */
2169 #define PLT_RELOC(code, target) { \
2170 Elf64_Sxword rel_value = target - gp_val; \
2171 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2172 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2174 ia64_reloc_gprel22((Elf_Addr)code, target); \
2179 unsigned char code[sizeof(plt_code)];
2183 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2185 PLTEntry *plt = (PLTEntry *)oc->plt;
2188 if (oc->pltIndex >= PLT_SIZE)
2189 barf("Procedure table overflow");
2191 entry = &plt[oc->pltIndex++];
2192 memcpy(entry->code, plt_code, sizeof(entry->code));
2193 PLT_RELOC(entry->code, target);
2194 return (Elf_Addr)entry;
2200 return (PLT_SIZE * sizeof(PLTEntry));
2206 * Generic ELF functions
2210 findElfSection ( void* objImage, Elf_Word sh_type )
2212 char* ehdrC = (char*)objImage;
2213 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2214 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2215 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2219 for (i = 0; i < ehdr->e_shnum; i++) {
2220 if (shdr[i].sh_type == sh_type
2221 /* Ignore the section header's string table. */
2222 && i != ehdr->e_shstrndx
2223 /* Ignore string tables named .stabstr, as they contain
2225 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2227 ptr = ehdrC + shdr[i].sh_offset;
2234 #if defined(ia64_TARGET_ARCH)
2236 findElfSegment ( void* objImage, Elf_Addr vaddr )
2238 char* ehdrC = (char*)objImage;
2239 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2240 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2241 Elf_Addr segaddr = 0;
2244 for (i = 0; i < ehdr->e_phnum; i++) {
2245 segaddr = phdr[i].p_vaddr;
2246 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2254 ocVerifyImage_ELF ( ObjectCode* oc )
2258 int i, j, nent, nstrtab, nsymtabs;
2262 char* ehdrC = (char*)(oc->image);
2263 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2265 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2266 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2267 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2268 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2269 belch("%s: not an ELF object", oc->fileName);
2273 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2274 belch("%s: unsupported ELF format", oc->fileName);
2278 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2279 IF_DEBUG(linker,belch( "Is little-endian" ));
2281 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2282 IF_DEBUG(linker,belch( "Is big-endian" ));
2284 belch("%s: unknown endiannness", oc->fileName);
2288 if (ehdr->e_type != ET_REL) {
2289 belch("%s: not a relocatable object (.o) file", oc->fileName);
2292 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2294 IF_DEBUG(linker,belch( "Architecture is " ));
2295 switch (ehdr->e_machine) {
2296 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2297 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2299 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2301 default: IF_DEBUG(linker,belch( "unknown" ));
2302 belch("%s: unknown architecture", oc->fileName);
2306 IF_DEBUG(linker,belch(
2307 "\nSection header table: start %d, n_entries %d, ent_size %d",
2308 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2310 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2312 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2314 if (ehdr->e_shstrndx == SHN_UNDEF) {
2315 belch("%s: no section header string table", oc->fileName);
2318 IF_DEBUG(linker,belch( "Section header string table is section %d",
2320 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2323 for (i = 0; i < ehdr->e_shnum; i++) {
2324 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2325 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2326 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2327 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2328 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2329 ehdrC + shdr[i].sh_offset,
2330 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2332 if (shdr[i].sh_type == SHT_REL) {
2333 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2334 } else if (shdr[i].sh_type == SHT_RELA) {
2335 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2337 IF_DEBUG(linker,fprintf(stderr," "));
2340 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2344 IF_DEBUG(linker,belch( "\nString tables" ));
2347 for (i = 0; i < ehdr->e_shnum; i++) {
2348 if (shdr[i].sh_type == SHT_STRTAB
2349 /* Ignore the section header's string table. */
2350 && i != ehdr->e_shstrndx
2351 /* Ignore string tables named .stabstr, as they contain
2353 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2355 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2356 strtab = ehdrC + shdr[i].sh_offset;
2361 belch("%s: no string tables, or too many", oc->fileName);
2366 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2367 for (i = 0; i < ehdr->e_shnum; i++) {
2368 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2369 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2371 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2372 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2373 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2375 shdr[i].sh_size % sizeof(Elf_Sym)
2377 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2378 belch("%s: non-integral number of symbol table entries", oc->fileName);
2381 for (j = 0; j < nent; j++) {
2382 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2383 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2384 (int)stab[j].st_shndx,
2385 (int)stab[j].st_size,
2386 (char*)stab[j].st_value ));
2388 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2389 switch (ELF_ST_TYPE(stab[j].st_info)) {
2390 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2391 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2392 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2393 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2394 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2395 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2397 IF_DEBUG(linker,fprintf(stderr, " " ));
2399 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2400 switch (ELF_ST_BIND(stab[j].st_info)) {
2401 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2402 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2403 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2404 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2406 IF_DEBUG(linker,fprintf(stderr, " " ));
2408 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2412 if (nsymtabs == 0) {
2413 belch("%s: didn't find any symbol tables", oc->fileName);
2422 ocGetNames_ELF ( ObjectCode* oc )
2427 char* ehdrC = (char*)(oc->image);
2428 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2429 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2430 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2432 ASSERT(symhash != NULL);
2435 belch("%s: no strtab", oc->fileName);
2440 for (i = 0; i < ehdr->e_shnum; i++) {
2441 /* Figure out what kind of section it is. Logic derived from
2442 Figure 1.14 ("Special Sections") of the ELF document
2443 ("Portable Formats Specification, Version 1.1"). */
2444 Elf_Shdr hdr = shdr[i];
2445 SectionKind kind = SECTIONKIND_OTHER;
2448 if (hdr.sh_type == SHT_PROGBITS
2449 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2450 /* .text-style section */
2451 kind = SECTIONKIND_CODE_OR_RODATA;
2454 if (hdr.sh_type == SHT_PROGBITS
2455 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2456 /* .data-style section */
2457 kind = SECTIONKIND_RWDATA;
2460 if (hdr.sh_type == SHT_PROGBITS
2461 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2462 /* .rodata-style section */
2463 kind = SECTIONKIND_CODE_OR_RODATA;
2466 if (hdr.sh_type == SHT_NOBITS
2467 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2468 /* .bss-style section */
2469 kind = SECTIONKIND_RWDATA;
2473 if (is_bss && shdr[i].sh_size > 0) {
2474 /* This is a non-empty .bss section. Allocate zeroed space for
2475 it, and set its .sh_offset field such that
2476 ehdrC + .sh_offset == addr_of_zeroed_space. */
2477 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2478 "ocGetNames_ELF(BSS)");
2479 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2481 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2482 zspace, shdr[i].sh_size);
2486 /* fill in the section info */
2487 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2488 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2489 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2490 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2493 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2495 /* copy stuff into this module's object symbol table */
2496 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2497 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2499 oc->n_symbols = nent;
2500 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2501 "ocGetNames_ELF(oc->symbols)");
2503 for (j = 0; j < nent; j++) {
2505 char isLocal = FALSE; /* avoids uninit-var warning */
2507 char* nm = strtab + stab[j].st_name;
2508 int secno = stab[j].st_shndx;
2510 /* Figure out if we want to add it; if so, set ad to its
2511 address. Otherwise leave ad == NULL. */
2513 if (secno == SHN_COMMON) {
2515 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2517 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2518 stab[j].st_size, nm);
2520 /* Pointless to do addProddableBlock() for this area,
2521 since the linker should never poke around in it. */
2524 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2525 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2527 /* and not an undefined symbol */
2528 && stab[j].st_shndx != SHN_UNDEF
2529 /* and not in a "special section" */
2530 && stab[j].st_shndx < SHN_LORESERVE
2532 /* and it's a not a section or string table or anything silly */
2533 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2534 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2535 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2538 /* Section 0 is the undefined section, hence > and not >=. */
2539 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2541 if (shdr[secno].sh_type == SHT_NOBITS) {
2542 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2543 stab[j].st_size, stab[j].st_value, nm);
2546 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2547 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2550 #ifdef ELF_FUNCTION_DESC
2551 /* dlsym() and the initialisation table both give us function
2552 * descriptors, so to be consistent we store function descriptors
2553 * in the symbol table */
2554 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2555 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2557 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2558 ad, oc->fileName, nm ));
2563 /* And the decision is ... */
2567 oc->symbols[j] = nm;
2570 /* Ignore entirely. */
2572 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2576 IF_DEBUG(linker,belch( "skipping `%s'",
2577 strtab + stab[j].st_name ));
2580 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2581 (int)ELF_ST_BIND(stab[j].st_info),
2582 (int)ELF_ST_TYPE(stab[j].st_info),
2583 (int)stab[j].st_shndx,
2584 strtab + stab[j].st_name
2587 oc->symbols[j] = NULL;
2596 /* Do ELF relocations which lack an explicit addend. All x86-linux
2597 relocations appear to be of this form. */
2599 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2600 Elf_Shdr* shdr, int shnum,
2601 Elf_Sym* stab, char* strtab )
2606 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2607 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2608 int target_shndx = shdr[shnum].sh_info;
2609 int symtab_shndx = shdr[shnum].sh_link;
2611 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2612 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2613 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2614 target_shndx, symtab_shndx ));
2616 for (j = 0; j < nent; j++) {
2617 Elf_Addr offset = rtab[j].r_offset;
2618 Elf_Addr info = rtab[j].r_info;
2620 Elf_Addr P = ((Elf_Addr)targ) + offset;
2621 Elf_Word* pP = (Elf_Word*)P;
2626 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2627 j, (void*)offset, (void*)info ));
2629 IF_DEBUG(linker,belch( " ZERO" ));
2632 Elf_Sym sym = stab[ELF_R_SYM(info)];
2633 /* First see if it is a local symbol. */
2634 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2635 /* Yes, so we can get the address directly from the ELF symbol
2637 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2639 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2640 + stab[ELF_R_SYM(info)].st_value);
2643 /* No, so look up the name in our global table. */
2644 symbol = strtab + sym.st_name;
2645 (void*)S = lookupSymbol( symbol );
2648 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2651 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2654 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2655 (void*)P, (void*)S, (void*)A ));
2656 checkProddableBlock ( oc, pP );
2660 switch (ELF_R_TYPE(info)) {
2661 # ifdef i386_TARGET_ARCH
2662 case R_386_32: *pP = value; break;
2663 case R_386_PC32: *pP = value - P; break;
2666 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2667 oc->fileName, ELF_R_TYPE(info));
2675 /* Do ELF relocations for which explicit addends are supplied.
2676 sparc-solaris relocations appear to be of this form. */
2678 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2679 Elf_Shdr* shdr, int shnum,
2680 Elf_Sym* stab, char* strtab )
2685 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2686 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2687 int target_shndx = shdr[shnum].sh_info;
2688 int symtab_shndx = shdr[shnum].sh_link;
2690 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2691 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2692 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2693 target_shndx, symtab_shndx ));
2695 for (j = 0; j < nent; j++) {
2696 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2697 /* This #ifdef only serves to avoid unused-var warnings. */
2698 Elf_Addr offset = rtab[j].r_offset;
2699 Elf_Addr P = targ + offset;
2701 Elf_Addr info = rtab[j].r_info;
2702 Elf_Addr A = rtab[j].r_addend;
2705 # if defined(sparc_TARGET_ARCH)
2706 Elf_Word* pP = (Elf_Word*)P;
2708 # elif defined(ia64_TARGET_ARCH)
2709 Elf64_Xword *pP = (Elf64_Xword *)P;
2713 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2714 j, (void*)offset, (void*)info,
2717 IF_DEBUG(linker,belch( " ZERO" ));
2720 Elf_Sym sym = stab[ELF_R_SYM(info)];
2721 /* First see if it is a local symbol. */
2722 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2723 /* Yes, so we can get the address directly from the ELF symbol
2725 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2727 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2728 + stab[ELF_R_SYM(info)].st_value);
2729 #ifdef ELF_FUNCTION_DESC
2730 /* Make a function descriptor for this function */
2731 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2732 S = allocateFunctionDesc(S + A);
2737 /* No, so look up the name in our global table. */
2738 symbol = strtab + sym.st_name;
2739 (void*)S = lookupSymbol( symbol );
2741 #ifdef ELF_FUNCTION_DESC
2742 /* If a function, already a function descriptor - we would
2743 have to copy it to add an offset. */
2744 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2745 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2749 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2752 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2755 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2756 (void*)P, (void*)S, (void*)A ));
2757 /* checkProddableBlock ( oc, (void*)P ); */
2761 switch (ELF_R_TYPE(info)) {
2762 # if defined(sparc_TARGET_ARCH)
2763 case R_SPARC_WDISP30:
2764 w1 = *pP & 0xC0000000;
2765 w2 = (Elf_Word)((value - P) >> 2);
2766 ASSERT((w2 & 0xC0000000) == 0);
2771 w1 = *pP & 0xFFC00000;
2772 w2 = (Elf_Word)(value >> 10);
2773 ASSERT((w2 & 0xFFC00000) == 0);
2779 w2 = (Elf_Word)(value & 0x3FF);
2780 ASSERT((w2 & ~0x3FF) == 0);
2784 /* According to the Sun documentation:
2786 This relocation type resembles R_SPARC_32, except it refers to an
2787 unaligned word. That is, the word to be relocated must be treated
2788 as four separate bytes with arbitrary alignment, not as a word
2789 aligned according to the architecture requirements.
2791 (JRS: which means that freeloading on the R_SPARC_32 case
2792 is probably wrong, but hey ...)
2796 w2 = (Elf_Word)value;
2799 # elif defined(ia64_TARGET_ARCH)
2800 case R_IA64_DIR64LSB:
2801 case R_IA64_FPTR64LSB:
2804 case R_IA64_PCREL64LSB:
2807 case R_IA64_SEGREL64LSB:
2808 addr = findElfSegment(ehdrC, value);
2811 case R_IA64_GPREL22:
2812 ia64_reloc_gprel22(P, value);
2814 case R_IA64_LTOFF22:
2815 case R_IA64_LTOFF22X:
2816 case R_IA64_LTOFF_FPTR22:
2817 addr = allocateGOTEntry(value);
2818 ia64_reloc_gprel22(P, addr);
2820 case R_IA64_PCREL21B:
2821 ia64_reloc_pcrel21(P, S, oc);
2824 /* This goes with R_IA64_LTOFF22X and points to the load to
2825 * convert into a move. We don't implement relaxation. */
2829 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2830 oc->fileName, ELF_R_TYPE(info));
2839 ocResolve_ELF ( ObjectCode* oc )
2843 Elf_Sym* stab = NULL;
2844 char* ehdrC = (char*)(oc->image);
2845 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2846 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2847 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2849 /* first find "the" symbol table */
2850 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2852 /* also go find the string table */
2853 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2855 if (stab == NULL || strtab == NULL) {
2856 belch("%s: can't find string or symbol table", oc->fileName);
2860 /* Process the relocation sections. */
2861 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2863 /* Skip sections called ".rel.stab". These appear to contain
2864 relocation entries that, when done, make the stabs debugging
2865 info point at the right places. We ain't interested in all
2867 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2870 if (shdr[shnum].sh_type == SHT_REL ) {
2871 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2872 shnum, stab, strtab );
2876 if (shdr[shnum].sh_type == SHT_RELA) {
2877 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2878 shnum, stab, strtab );
2883 /* Free the local symbol table; we won't need it again. */
2884 freeHashTable(oc->lochash, NULL);
2892 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2893 * at the front. The following utility functions pack and unpack instructions, and
2894 * take care of the most common relocations.
2897 #ifdef ia64_TARGET_ARCH
2900 ia64_extract_instruction(Elf64_Xword *target)
2903 int slot = (Elf_Addr)target & 3;
2904 (Elf_Addr)target &= ~3;
2912 return ((w1 >> 5) & 0x1ffffffffff);
2914 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2918 barf("ia64_extract_instruction: invalid slot %p", target);
2923 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2925 int slot = (Elf_Addr)target & 3;
2926 (Elf_Addr)target &= ~3;
2931 *target |= value << 5;
2934 *target |= value << 46;
2935 *(target+1) |= value >> 18;
2938 *(target+1) |= value << 23;
2944 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2946 Elf64_Xword instruction;
2947 Elf64_Sxword rel_value;
2949 rel_value = value - gp_val;
2950 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2951 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2953 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2954 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2955 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2956 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2957 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2958 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2962 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2964 Elf64_Xword instruction;
2965 Elf64_Sxword rel_value;
2968 entry = allocatePLTEntry(value, oc);
2970 rel_value = (entry >> 4) - (target >> 4);
2971 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2972 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2974 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2975 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2976 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2977 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2984 /* --------------------------------------------------------------------------
2986 * ------------------------------------------------------------------------*/
2988 #if defined(OBJFORMAT_MACHO)
2991 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2992 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2994 I hereby formally apologize for the hackish nature of this code.
2995 Things that need to be done:
2996 *) get common symbols and .bss sections to work properly.
2997 Haskell modules seem to work, but C modules can cause problems
2998 *) implement ocVerifyImage_MachO
2999 *) add more sanity checks. The current code just has to segfault if there's a
3003 static int ocVerifyImage_MachO(ObjectCode* oc)
3005 // FIXME: do some verifying here
3009 static int resolveImports(
3012 struct symtab_command *symLC,
3013 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3014 unsigned long *indirectSyms,
3015 struct nlist *nlist)
3019 for(i=0;i*4<sect->size;i++)
3021 // according to otool, reserved1 contains the first index into the indirect symbol table
3022 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3023 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3026 if((symbol->n_type & N_TYPE) == N_UNDF
3027 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3028 addr = (void*) (symbol->n_value);
3029 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3032 addr = lookupSymbol(nm);
3035 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3039 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3040 ((void**)(image + sect->offset))[i] = addr;
3046 static int relocateSection(
3049 struct symtab_command *symLC, struct nlist *nlist,
3050 struct section* sections, struct section *sect)
3052 struct relocation_info *relocs;
3055 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3057 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3061 relocs = (struct relocation_info*) (image + sect->reloff);
3065 if(relocs[i].r_address & R_SCATTERED)
3067 struct scattered_relocation_info *scat =
3068 (struct scattered_relocation_info*) &relocs[i];
3072 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3074 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3076 checkProddableBlock(oc,word);
3077 *word = scat->r_value + sect->offset + ((long) image);
3081 continue; // FIXME: I hope it's OK to ignore all the others.
3085 struct relocation_info *reloc = &relocs[i];
3086 if(reloc->r_pcrel && !reloc->r_extern)
3089 if(reloc->r_length == 2)
3091 unsigned long word = 0;
3093 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3094 checkProddableBlock(oc,wordPtr);
3096 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3100 else if(reloc->r_type == PPC_RELOC_LO16)
3102 word = ((unsigned short*) wordPtr)[1];
3103 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3105 else if(reloc->r_type == PPC_RELOC_HI16)
3107 word = ((unsigned short*) wordPtr)[1] << 16;
3108 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3110 else if(reloc->r_type == PPC_RELOC_HA16)
3112 word = ((unsigned short*) wordPtr)[1] << 16;
3113 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3115 else if(reloc->r_type == PPC_RELOC_BR24)
3118 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3122 if(!reloc->r_extern)
3125 sections[reloc->r_symbolnum-1].offset
3126 - sections[reloc->r_symbolnum-1].addr
3133 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3134 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3135 word = (unsigned long) (lookupSymbol(nm));
3138 belch("\nunknown symbol `%s'", nm);
3143 word -= ((long)image) + sect->offset + reloc->r_address;
3146 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3151 else if(reloc->r_type == PPC_RELOC_LO16)
3153 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3156 else if(reloc->r_type == PPC_RELOC_HI16)
3158 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3161 else if(reloc->r_type == PPC_RELOC_HA16)
3163 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3164 + ((word & (1<<15)) ? 1 : 0);
3167 else if(reloc->r_type == PPC_RELOC_BR24)
3169 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3173 barf("\nunknown relocation %d",reloc->r_type);
3180 static int ocGetNames_MachO(ObjectCode* oc)
3182 char *image = (char*) oc->image;
3183 struct mach_header *header = (struct mach_header*) image;
3184 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3185 unsigned i,curSymbol;
3186 struct segment_command *segLC = NULL;
3187 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3188 struct symtab_command *symLC = NULL;
3189 struct dysymtab_command *dsymLC = NULL;
3190 struct nlist *nlist;
3191 unsigned long commonSize = 0;
3192 char *commonStorage = NULL;
3193 unsigned long commonCounter;
3195 for(i=0;i<header->ncmds;i++)
3197 if(lc->cmd == LC_SEGMENT)
3198 segLC = (struct segment_command*) lc;
3199 else if(lc->cmd == LC_SYMTAB)
3200 symLC = (struct symtab_command*) lc;
3201 else if(lc->cmd == LC_DYSYMTAB)
3202 dsymLC = (struct dysymtab_command*) lc;
3203 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3206 sections = (struct section*) (segLC+1);
3207 nlist = (struct nlist*) (image + symLC->symoff);
3209 for(i=0;i<segLC->nsects;i++)
3211 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3212 la_ptrs = §ions[i];
3213 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3214 nl_ptrs = §ions[i];
3216 // for now, only add __text and __const to the sections table
3217 else if(!strcmp(sections[i].sectname,"__text"))
3218 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3219 (void*) (image + sections[i].offset),
3220 (void*) (image + sections[i].offset + sections[i].size));
3221 else if(!strcmp(sections[i].sectname,"__const"))
3222 addSection(oc, SECTIONKIND_RWDATA,
3223 (void*) (image + sections[i].offset),
3224 (void*) (image + sections[i].offset + sections[i].size));
3225 else if(!strcmp(sections[i].sectname,"__data"))
3226 addSection(oc, SECTIONKIND_RWDATA,
3227 (void*) (image + sections[i].offset),
3228 (void*) (image + sections[i].offset + sections[i].size));
3230 if(sections[i].size > 0) // size 0 segments do exist
3231 addProddableBlock(oc, (void*) (image + sections[i].offset),
3235 // count external symbols defined here
3237 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3239 if((nlist[i].n_type & N_TYPE) == N_SECT)
3242 for(i=0;i<symLC->nsyms;i++)
3244 if((nlist[i].n_type & N_TYPE) == N_UNDF
3245 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3247 commonSize += nlist[i].n_value;
3251 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3252 "ocGetNames_MachO(oc->symbols)");
3254 // insert symbols into hash table
3255 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3257 if((nlist[i].n_type & N_TYPE) == N_SECT)
3259 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3260 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3261 sections[nlist[i].n_sect-1].offset
3262 - sections[nlist[i].n_sect-1].addr
3263 + nlist[i].n_value);
3264 oc->symbols[curSymbol++] = nm;
3268 // insert local symbols into lochash
3269 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3271 if((nlist[i].n_type & N_TYPE) == N_SECT)
3273 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3274 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3275 sections[nlist[i].n_sect-1].offset
3276 - sections[nlist[i].n_sect-1].addr
3277 + nlist[i].n_value);
3282 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3283 commonCounter = (unsigned long)commonStorage;
3284 for(i=0;i<symLC->nsyms;i++)
3286 if((nlist[i].n_type & N_TYPE) == N_UNDF
3287 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3289 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3290 unsigned long sz = nlist[i].n_value;
3292 nlist[i].n_value = commonCounter;
3294 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3295 oc->symbols[curSymbol++] = nm;
3297 commonCounter += sz;
3303 static int ocResolve_MachO(ObjectCode* oc)
3305 char *image = (char*) oc->image;
3306 struct mach_header *header = (struct mach_header*) image;
3307 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3309 struct segment_command *segLC = NULL;
3310 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3311 struct symtab_command *symLC = NULL;
3312 struct dysymtab_command *dsymLC = NULL;
3313 struct nlist *nlist;
3314 unsigned long *indirectSyms;
3316 for(i=0;i<header->ncmds;i++)
3318 if(lc->cmd == LC_SEGMENT)
3319 segLC = (struct segment_command*) lc;
3320 else if(lc->cmd == LC_SYMTAB)
3321 symLC = (struct symtab_command*) lc;
3322 else if(lc->cmd == LC_DYSYMTAB)
3323 dsymLC = (struct dysymtab_command*) lc;
3324 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3327 sections = (struct section*) (segLC+1);
3328 nlist = (struct nlist*) (image + symLC->symoff);
3330 for(i=0;i<segLC->nsects;i++)
3332 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3333 la_ptrs = §ions[i];
3334 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3335 nl_ptrs = §ions[i];
3338 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3341 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3344 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3347 for(i=0;i<segLC->nsects;i++)
3349 if(!relocateSection(oc,image,symLC,nlist,sections,§ions[i]))
3353 /* Free the local symbol table; we won't need it again. */
3354 freeHashTable(oc->lochash, NULL);
3360 * The Mach-O object format uses leading underscores. But not everywhere.
3361 * There is a small number of runtime support functions defined in
3362 * libcc_dynamic.a whose name does not have a leading underscore.
3363 * As a consequence, we can't get their address from C code.
3364 * We have to use inline assembler just to take the address of a function.
3368 static void machoInitSymbolsWithoutUnderscore()
3374 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3375 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3377 RTS_MACHO_NOUNDERLINE_SYMBOLS