1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.132 2003/09/25 09:19:23 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>
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(forkOS_createThread) \
374 SymX(freeHaskellFunctionPtr) \
375 SymX(freeStablePtr) \
376 SymX(gcdIntegerzh_fast) \
377 SymX(gcdIntegerIntzh_fast) \
378 SymX(gcdIntzh_fast) \
382 SymX(int2Integerzh_fast) \
383 SymX(integer2Intzh_fast) \
384 SymX(integer2Wordzh_fast) \
385 SymX(isCurrentThreadBoundzh_fast) \
386 SymX(isDoubleDenormalized) \
387 SymX(isDoubleInfinite) \
389 SymX(isDoubleNegativeZero) \
390 SymX(isEmptyMVarzh_fast) \
391 SymX(isFloatDenormalized) \
392 SymX(isFloatInfinite) \
394 SymX(isFloatNegativeZero) \
395 SymX(killThreadzh_fast) \
396 SymX(makeStablePtrzh_fast) \
397 SymX(minusIntegerzh_fast) \
398 SymX(mkApUpd0zh_fast) \
399 SymX(myThreadIdzh_fast) \
400 SymX(labelThreadzh_fast) \
401 SymX(newArrayzh_fast) \
402 SymX(newBCOzh_fast) \
403 SymX(newByteArrayzh_fast) \
404 SymX_redirect(newCAF, newDynCAF) \
405 SymX(newMVarzh_fast) \
406 SymX(newMutVarzh_fast) \
407 SymX(atomicModifyMutVarzh_fast) \
408 SymX(newPinnedByteArrayzh_fast) \
409 SymX(orIntegerzh_fast) \
411 SymX(plusIntegerzh_fast) \
414 SymX(putMVarzh_fast) \
415 SymX(quotIntegerzh_fast) \
416 SymX(quotRemIntegerzh_fast) \
418 SymX(raiseIOzh_fast) \
419 SymX(remIntegerzh_fast) \
420 SymX(resetNonBlockingFd) \
423 SymX(rts_checkSchedStatus) \
426 SymX(rts_evalLazyIO) \
427 SymX(rts_evalStableIO) \
431 SymX(rts_getDouble) \
436 SymX(rts_getFunPtr) \
437 SymX(rts_getStablePtr) \
438 SymX(rts_getThreadId) \
440 SymX(rts_getWord32) \
453 SymX(rts_mkStablePtr) \
461 SymX(rtsSupportsBoundThreads) \
465 SymX(startupHaskell) \
466 SymX(shutdownHaskell) \
467 SymX(shutdownHaskellAndExit) \
468 SymX(stable_ptr_table) \
469 SymX(stackOverflow) \
470 SymX(stg_CAF_BLACKHOLE_info) \
471 SymX(stg_BLACKHOLE_BQ_info) \
472 SymX(awakenBlockedQueue) \
473 SymX(stg_CHARLIKE_closure) \
474 SymX(stg_EMPTY_MVAR_info) \
475 SymX(stg_IND_STATIC_info) \
476 SymX(stg_INTLIKE_closure) \
477 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
478 SymX(stg_WEAK_info) \
479 SymX(stg_ap_v_info) \
480 SymX(stg_ap_f_info) \
481 SymX(stg_ap_d_info) \
482 SymX(stg_ap_l_info) \
483 SymX(stg_ap_n_info) \
484 SymX(stg_ap_p_info) \
485 SymX(stg_ap_pv_info) \
486 SymX(stg_ap_pp_info) \
487 SymX(stg_ap_ppv_info) \
488 SymX(stg_ap_ppp_info) \
489 SymX(stg_ap_pppp_info) \
490 SymX(stg_ap_ppppp_info) \
491 SymX(stg_ap_pppppp_info) \
492 SymX(stg_ap_ppppppp_info) \
500 SymX(stg_ap_pv_ret) \
501 SymX(stg_ap_pp_ret) \
502 SymX(stg_ap_ppv_ret) \
503 SymX(stg_ap_ppp_ret) \
504 SymX(stg_ap_pppp_ret) \
505 SymX(stg_ap_ppppp_ret) \
506 SymX(stg_ap_pppppp_ret) \
507 SymX(stg_ap_ppppppp_ret) \
508 SymX(stg_ap_1_upd_info) \
509 SymX(stg_ap_2_upd_info) \
510 SymX(stg_ap_3_upd_info) \
511 SymX(stg_ap_4_upd_info) \
512 SymX(stg_ap_5_upd_info) \
513 SymX(stg_ap_6_upd_info) \
514 SymX(stg_ap_7_upd_info) \
515 SymX(stg_ap_8_upd_info) \
517 SymX(stg_sel_0_upd_info) \
518 SymX(stg_sel_10_upd_info) \
519 SymX(stg_sel_11_upd_info) \
520 SymX(stg_sel_12_upd_info) \
521 SymX(stg_sel_13_upd_info) \
522 SymX(stg_sel_14_upd_info) \
523 SymX(stg_sel_15_upd_info) \
524 SymX(stg_sel_1_upd_info) \
525 SymX(stg_sel_2_upd_info) \
526 SymX(stg_sel_3_upd_info) \
527 SymX(stg_sel_4_upd_info) \
528 SymX(stg_sel_5_upd_info) \
529 SymX(stg_sel_6_upd_info) \
530 SymX(stg_sel_7_upd_info) \
531 SymX(stg_sel_8_upd_info) \
532 SymX(stg_sel_9_upd_info) \
533 SymX(stg_upd_frame_info) \
534 SymX(suspendThread) \
535 SymX(takeMVarzh_fast) \
536 SymX(timesIntegerzh_fast) \
537 SymX(tryPutMVarzh_fast) \
538 SymX(tryTakeMVarzh_fast) \
539 SymX(unblockAsyncExceptionszh_fast) \
540 SymX(unsafeThawArrayzh_fast) \
541 SymX(waitReadzh_fast) \
542 SymX(waitWritezh_fast) \
543 SymX(word2Integerzh_fast) \
544 SymX(xorIntegerzh_fast) \
547 #ifdef SUPPORT_LONG_LONGS
548 #define RTS_LONG_LONG_SYMS \
549 SymX(int64ToIntegerzh_fast) \
550 SymX(word64ToIntegerzh_fast)
552 #define RTS_LONG_LONG_SYMS /* nothing */
555 // 64-bit support functions in libgcc.a
556 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
557 #define RTS_LIBGCC_SYMBOLS \
566 #elif defined(ia64_TARGET_ARCH)
567 #define RTS_LIBGCC_SYMBOLS \
575 #define RTS_LIBGCC_SYMBOLS
578 #ifdef darwin_TARGET_OS
579 // Symbols that don't have a leading underscore
580 // on Mac OS X. They have to receive special treatment,
581 // see machoInitSymbolsWithoutUnderscore()
582 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
587 /* entirely bogus claims about types of these symbols */
588 #define Sym(vvv) extern void vvv(void);
589 #define SymX(vvv) /**/
590 #define SymX_redirect(vvv,xxx) /**/
593 RTS_POSIX_ONLY_SYMBOLS
594 RTS_MINGW_ONLY_SYMBOLS
595 RTS_CYGWIN_ONLY_SYMBOLS
601 #ifdef LEADING_UNDERSCORE
602 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
604 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
607 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
609 #define SymX(vvv) Sym(vvv)
611 // SymX_redirect allows us to redirect references to one symbol to
612 // another symbol. See newCAF/newDynCAF for an example.
613 #define SymX_redirect(vvv,xxx) \
614 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
617 static RtsSymbolVal rtsSyms[] = {
620 RTS_POSIX_ONLY_SYMBOLS
621 RTS_MINGW_ONLY_SYMBOLS
622 RTS_CYGWIN_ONLY_SYMBOLS
624 { 0, 0 } /* sentinel */
627 /* -----------------------------------------------------------------------------
628 * Insert symbols into hash tables, checking for duplicates.
630 static void ghciInsertStrHashTable ( char* obj_name,
636 if (lookupHashTable(table, (StgWord)key) == NULL)
638 insertStrHashTable(table, (StgWord)key, data);
643 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
645 "whilst processing object file\n"
647 "This could be caused by:\n"
648 " * Loading two different object files which export the same symbol\n"
649 " * Specifying the same object file twice on the GHCi command line\n"
650 " * An incorrect `package.conf' entry, causing some object to be\n"
652 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
661 /* -----------------------------------------------------------------------------
662 * initialize the object linker
666 static int linker_init_done = 0 ;
668 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
669 static void *dl_prog_handle;
677 /* Make initLinker idempotent, so we can call it
678 before evey relevant operation; that means we
679 don't need to initialise the linker separately */
680 if (linker_init_done == 1) { return; } else {
681 linker_init_done = 1;
684 symhash = allocStrHashTable();
686 /* populate the symbol table with stuff from the RTS */
687 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
688 ghciInsertStrHashTable("(GHCi built-in symbols)",
689 symhash, sym->lbl, sym->addr);
691 # if defined(OBJFORMAT_MACHO)
692 machoInitSymbolsWithoutUnderscore();
695 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
696 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
700 /* -----------------------------------------------------------------------------
701 * Loading DLL or .so dynamic libraries
702 * -----------------------------------------------------------------------------
704 * Add a DLL from which symbols may be found. In the ELF case, just
705 * do RTLD_GLOBAL-style add, so no further messing around needs to
706 * happen in order that symbols in the loaded .so are findable --
707 * lookupSymbol() will subsequently see them by dlsym on the program's
708 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
710 * In the PEi386 case, open the DLLs and put handles to them in a
711 * linked list. When looking for a symbol, try all handles in the
712 * list. This means that we need to load even DLLs that are guaranteed
713 * to be in the ghc.exe image already, just so we can get a handle
714 * to give to loadSymbol, so that we can find the symbols. For such
715 * libraries, the LoadLibrary call should be a no-op except for returning
720 #if defined(OBJFORMAT_PEi386)
721 /* A record for storing handles into DLLs. */
726 struct _OpenedDLL* next;
731 /* A list thereof. */
732 static OpenedDLL* opened_dlls = NULL;
736 addDLL( char *dll_name )
738 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
739 /* ------------------- ELF DLL loader ------------------- */
745 #if !defined(openbsd_TARGET_OS)
746 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
748 hdl= dlopen(dll_name, RTLD_LAZY);
751 /* dlopen failed; return a ptr to the error msg. */
753 if (errmsg == NULL) errmsg = "addDLL: unknown error";
760 # elif defined(OBJFORMAT_PEi386)
761 /* ------------------- Win32 DLL loader ------------------- */
769 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
771 /* See if we've already got it, and ignore if so. */
772 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
773 if (0 == strcmp(o_dll->name, dll_name))
777 /* The file name has no suffix (yet) so that we can try
778 both foo.dll and foo.drv
780 The documentation for LoadLibrary says:
781 If no file name extension is specified in the lpFileName
782 parameter, the default library extension .dll is
783 appended. However, the file name string can include a trailing
784 point character (.) to indicate that the module name has no
787 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
788 sprintf(buf, "%s.DLL", dll_name);
789 instance = LoadLibrary(buf);
790 if (instance == NULL) {
791 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
792 instance = LoadLibrary(buf);
793 if (instance == NULL) {
796 /* LoadLibrary failed; return a ptr to the error msg. */
797 return "addDLL: unknown error";
802 /* Add this DLL to the list of DLLs in which to search for symbols. */
803 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
804 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
805 strcpy(o_dll->name, dll_name);
806 o_dll->instance = instance;
807 o_dll->next = opened_dlls;
812 barf("addDLL: not implemented on this platform");
816 /* -----------------------------------------------------------------------------
817 * lookup a symbol in the hash table
820 lookupSymbol( char *lbl )
824 ASSERT(symhash != NULL);
825 val = lookupStrHashTable(symhash, lbl);
828 # if defined(OBJFORMAT_ELF)
829 return dlsym(dl_prog_handle, lbl);
830 # elif defined(OBJFORMAT_MACHO)
831 if(NSIsSymbolNameDefined(lbl)) {
832 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
833 return NSAddressOfSymbol(symbol);
837 # elif defined(OBJFORMAT_PEi386)
840 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
841 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
843 /* HACK: if the name has an initial underscore, try stripping
844 it off & look that up first. I've yet to verify whether there's
845 a Rule that governs whether an initial '_' *should always* be
846 stripped off when mapping from import lib name to the DLL name.
848 sym = GetProcAddress(o_dll->instance, (lbl+1));
850 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
854 sym = GetProcAddress(o_dll->instance, lbl);
856 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
871 __attribute((unused))
873 lookupLocalSymbol( ObjectCode* oc, char *lbl )
877 val = lookupStrHashTable(oc->lochash, lbl);
887 /* -----------------------------------------------------------------------------
888 * Debugging aid: look in GHCi's object symbol tables for symbols
889 * within DELTA bytes of the specified address, and show their names.
892 void ghci_enquire ( char* addr );
894 void ghci_enquire ( char* addr )
899 const int DELTA = 64;
904 for (oc = objects; oc; oc = oc->next) {
905 for (i = 0; i < oc->n_symbols; i++) {
906 sym = oc->symbols[i];
907 if (sym == NULL) continue;
908 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
910 if (oc->lochash != NULL) {
911 a = lookupStrHashTable(oc->lochash, sym);
914 a = lookupStrHashTable(symhash, sym);
917 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
919 else if (addr-DELTA <= a && a <= addr+DELTA) {
920 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
927 #ifdef ia64_TARGET_ARCH
928 static unsigned int PLTSize(void);
931 /* -----------------------------------------------------------------------------
932 * Load an obj (populate the global symbol table, but don't resolve yet)
934 * Returns: 1 if ok, 0 on error.
937 loadObj( char *path )
951 /* fprintf(stderr, "loadObj %s\n", path ); */
953 /* Check that we haven't already loaded this object. Don't give up
954 at this stage; ocGetNames_* will barf later. */
958 for (o = objects; o; o = o->next) {
959 if (0 == strcmp(o->fileName, path))
965 "GHCi runtime linker: warning: looks like you're trying to load the\n"
966 "same object file twice:\n"
968 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
974 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
976 # if defined(OBJFORMAT_ELF)
977 oc->formatName = "ELF";
978 # elif defined(OBJFORMAT_PEi386)
979 oc->formatName = "PEi386";
980 # elif defined(OBJFORMAT_MACHO)
981 oc->formatName = "Mach-O";
984 barf("loadObj: not implemented on this platform");
988 if (r == -1) { return 0; }
990 /* sigh, strdup() isn't a POSIX function, so do it the long way */
991 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
992 strcpy(oc->fileName, path);
994 oc->fileSize = st.st_size;
997 oc->lochash = allocStrHashTable();
998 oc->proddables = NULL;
1000 /* chain it onto the list of objects */
1005 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1007 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1009 fd = open(path, O_RDONLY);
1011 barf("loadObj: can't open `%s'", path);
1013 pagesize = getpagesize();
1015 #ifdef ia64_TARGET_ARCH
1016 /* The PLT needs to be right before the object */
1017 n = ROUND_UP(PLTSize(), pagesize);
1018 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1019 if (oc->plt == MAP_FAILED)
1020 barf("loadObj: can't allocate PLT");
1023 map_addr = oc->plt + n;
1026 n = ROUND_UP(oc->fileSize, pagesize);
1027 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1028 if (oc->image == MAP_FAILED)
1029 barf("loadObj: can't map `%s'", path);
1033 #else /* !USE_MMAP */
1035 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1037 /* load the image into memory */
1038 f = fopen(path, "rb");
1040 barf("loadObj: can't read `%s'", path);
1042 n = fread ( oc->image, 1, oc->fileSize, f );
1043 if (n != oc->fileSize)
1044 barf("loadObj: error whilst reading `%s'", path);
1048 #endif /* USE_MMAP */
1050 /* verify the in-memory image */
1051 # if defined(OBJFORMAT_ELF)
1052 r = ocVerifyImage_ELF ( oc );
1053 # elif defined(OBJFORMAT_PEi386)
1054 r = ocVerifyImage_PEi386 ( oc );
1055 # elif defined(OBJFORMAT_MACHO)
1056 r = ocVerifyImage_MachO ( oc );
1058 barf("loadObj: no verify method");
1060 if (!r) { return r; }
1062 /* build the symbol list for this image */
1063 # if defined(OBJFORMAT_ELF)
1064 r = ocGetNames_ELF ( oc );
1065 # elif defined(OBJFORMAT_PEi386)
1066 r = ocGetNames_PEi386 ( oc );
1067 # elif defined(OBJFORMAT_MACHO)
1068 r = ocGetNames_MachO ( oc );
1070 barf("loadObj: no getNames method");
1072 if (!r) { return r; }
1074 /* loaded, but not resolved yet */
1075 oc->status = OBJECT_LOADED;
1080 /* -----------------------------------------------------------------------------
1081 * resolve all the currently unlinked objects in memory
1083 * Returns: 1 if ok, 0 on error.
1093 for (oc = objects; oc; oc = oc->next) {
1094 if (oc->status != OBJECT_RESOLVED) {
1095 # if defined(OBJFORMAT_ELF)
1096 r = ocResolve_ELF ( oc );
1097 # elif defined(OBJFORMAT_PEi386)
1098 r = ocResolve_PEi386 ( oc );
1099 # elif defined(OBJFORMAT_MACHO)
1100 r = ocResolve_MachO ( oc );
1102 barf("resolveObjs: not implemented on this platform");
1104 if (!r) { return r; }
1105 oc->status = OBJECT_RESOLVED;
1111 /* -----------------------------------------------------------------------------
1112 * delete an object from the pool
1115 unloadObj( char *path )
1117 ObjectCode *oc, *prev;
1119 ASSERT(symhash != NULL);
1120 ASSERT(objects != NULL);
1125 for (oc = objects; oc; prev = oc, oc = oc->next) {
1126 if (!strcmp(oc->fileName,path)) {
1128 /* Remove all the mappings for the symbols within this
1133 for (i = 0; i < oc->n_symbols; i++) {
1134 if (oc->symbols[i] != NULL) {
1135 removeStrHashTable(symhash, oc->symbols[i], NULL);
1143 prev->next = oc->next;
1146 /* We're going to leave this in place, in case there are
1147 any pointers from the heap into it: */
1148 /* stgFree(oc->image); */
1149 stgFree(oc->fileName);
1150 stgFree(oc->symbols);
1151 stgFree(oc->sections);
1152 /* The local hash table should have been freed at the end
1153 of the ocResolve_ call on it. */
1154 ASSERT(oc->lochash == NULL);
1160 belch("unloadObj: can't find `%s' to unload", path);
1164 /* -----------------------------------------------------------------------------
1165 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1166 * which may be prodded during relocation, and abort if we try and write
1167 * outside any of these.
1169 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1172 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1173 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1177 pb->next = oc->proddables;
1178 oc->proddables = pb;
1181 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1184 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1185 char* s = (char*)(pb->start);
1186 char* e = s + pb->size - 1;
1187 char* a = (char*)addr;
1188 /* Assumes that the biggest fixup involves a 4-byte write. This
1189 probably needs to be changed to 8 (ie, +7) on 64-bit
1191 if (a >= s && (a+3) <= e) return;
1193 barf("checkProddableBlock: invalid fixup in runtime linker");
1196 /* -----------------------------------------------------------------------------
1197 * Section management.
1199 static void addSection ( ObjectCode* oc, SectionKind kind,
1200 void* start, void* end )
1202 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1206 s->next = oc->sections;
1209 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1210 start, ((char*)end)-1, end - start + 1, kind );
1216 /* --------------------------------------------------------------------------
1217 * PEi386 specifics (Win32 targets)
1218 * ------------------------------------------------------------------------*/
1220 /* The information for this linker comes from
1221 Microsoft Portable Executable
1222 and Common Object File Format Specification
1223 revision 5.1 January 1998
1224 which SimonM says comes from the MS Developer Network CDs.
1226 It can be found there (on older CDs), but can also be found
1229 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1231 (this is Rev 6.0 from February 1999).
1233 Things move, so if that fails, try searching for it via
1235 http://www.google.com/search?q=PE+COFF+specification
1237 The ultimate reference for the PE format is the Winnt.h
1238 header file that comes with the Platform SDKs; as always,
1239 implementations will drift wrt their documentation.
1241 A good background article on the PE format is Matt Pietrek's
1242 March 1994 article in Microsoft System Journal (MSJ)
1243 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1244 Win32 Portable Executable File Format." The info in there
1245 has recently been updated in a two part article in
1246 MSDN magazine, issues Feb and March 2002,
1247 "Inside Windows: An In-Depth Look into the Win32 Portable
1248 Executable File Format"
1250 John Levine's book "Linkers and Loaders" contains useful
1255 #if defined(OBJFORMAT_PEi386)
1259 typedef unsigned char UChar;
1260 typedef unsigned short UInt16;
1261 typedef unsigned int UInt32;
1268 UInt16 NumberOfSections;
1269 UInt32 TimeDateStamp;
1270 UInt32 PointerToSymbolTable;
1271 UInt32 NumberOfSymbols;
1272 UInt16 SizeOfOptionalHeader;
1273 UInt16 Characteristics;
1277 #define sizeof_COFF_header 20
1284 UInt32 VirtualAddress;
1285 UInt32 SizeOfRawData;
1286 UInt32 PointerToRawData;
1287 UInt32 PointerToRelocations;
1288 UInt32 PointerToLinenumbers;
1289 UInt16 NumberOfRelocations;
1290 UInt16 NumberOfLineNumbers;
1291 UInt32 Characteristics;
1295 #define sizeof_COFF_section 40
1302 UInt16 SectionNumber;
1305 UChar NumberOfAuxSymbols;
1309 #define sizeof_COFF_symbol 18
1314 UInt32 VirtualAddress;
1315 UInt32 SymbolTableIndex;
1320 #define sizeof_COFF_reloc 10
1323 /* From PE spec doc, section 3.3.2 */
1324 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1325 windows.h -- for the same purpose, but I want to know what I'm
1327 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1328 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1329 #define MYIMAGE_FILE_DLL 0x2000
1330 #define MYIMAGE_FILE_SYSTEM 0x1000
1331 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1332 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1333 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1335 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1336 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1337 #define MYIMAGE_SYM_CLASS_STATIC 3
1338 #define MYIMAGE_SYM_UNDEFINED 0
1340 /* From PE spec doc, section 4.1 */
1341 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1342 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1343 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1345 /* From PE spec doc, section 5.2.1 */
1346 #define MYIMAGE_REL_I386_DIR32 0x0006
1347 #define MYIMAGE_REL_I386_REL32 0x0014
1350 /* We use myindex to calculate array addresses, rather than
1351 simply doing the normal subscript thing. That's because
1352 some of the above structs have sizes which are not
1353 a whole number of words. GCC rounds their sizes up to a
1354 whole number of words, which means that the address calcs
1355 arising from using normal C indexing or pointer arithmetic
1356 are just plain wrong. Sigh.
1359 myindex ( int scale, void* base, int index )
1362 ((UChar*)base) + scale * index;
1367 printName ( UChar* name, UChar* strtab )
1369 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1370 UInt32 strtab_offset = * (UInt32*)(name+4);
1371 fprintf ( stderr, "%s", strtab + strtab_offset );
1374 for (i = 0; i < 8; i++) {
1375 if (name[i] == 0) break;
1376 fprintf ( stderr, "%c", name[i] );
1383 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1385 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1386 UInt32 strtab_offset = * (UInt32*)(name+4);
1387 strncpy ( dst, strtab+strtab_offset, dstSize );
1393 if (name[i] == 0) break;
1403 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1406 /* If the string is longer than 8 bytes, look in the
1407 string table for it -- this will be correctly zero terminated.
1409 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1410 UInt32 strtab_offset = * (UInt32*)(name+4);
1411 return ((UChar*)strtab) + strtab_offset;
1413 /* Otherwise, if shorter than 8 bytes, return the original,
1414 which by defn is correctly terminated.
1416 if (name[7]==0) return name;
1417 /* The annoying case: 8 bytes. Copy into a temporary
1418 (which is never freed ...)
1420 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1422 strncpy(newstr,name,8);
1428 /* Just compares the short names (first 8 chars) */
1429 static COFF_section *
1430 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1434 = (COFF_header*)(oc->image);
1435 COFF_section* sectab
1437 ((UChar*)(oc->image))
1438 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1440 for (i = 0; i < hdr->NumberOfSections; i++) {
1443 COFF_section* section_i
1445 myindex ( sizeof_COFF_section, sectab, i );
1446 n1 = (UChar*) &(section_i->Name);
1448 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1449 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1450 n1[6]==n2[6] && n1[7]==n2[7])
1459 zapTrailingAtSign ( UChar* sym )
1461 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1463 if (sym[0] == 0) return;
1465 while (sym[i] != 0) i++;
1468 while (j > 0 && my_isdigit(sym[j])) j--;
1469 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1475 ocVerifyImage_PEi386 ( ObjectCode* oc )
1480 COFF_section* sectab;
1481 COFF_symbol* symtab;
1483 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1484 hdr = (COFF_header*)(oc->image);
1485 sectab = (COFF_section*) (
1486 ((UChar*)(oc->image))
1487 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1489 symtab = (COFF_symbol*) (
1490 ((UChar*)(oc->image))
1491 + hdr->PointerToSymbolTable
1493 strtab = ((UChar*)symtab)
1494 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1496 if (hdr->Machine != 0x14c) {
1497 belch("Not x86 PEi386");
1500 if (hdr->SizeOfOptionalHeader != 0) {
1501 belch("PEi386 with nonempty optional header");
1504 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1505 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1506 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1507 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1508 belch("Not a PEi386 object file");
1511 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1512 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1513 belch("Invalid PEi386 word size or endiannness: %d",
1514 (int)(hdr->Characteristics));
1517 /* If the string table size is way crazy, this might indicate that
1518 there are more than 64k relocations, despite claims to the
1519 contrary. Hence this test. */
1520 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1522 if ( (*(UInt32*)strtab) > 600000 ) {
1523 /* Note that 600k has no special significance other than being
1524 big enough to handle the almost-2MB-sized lumps that
1525 constitute HSwin32*.o. */
1526 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1531 /* No further verification after this point; only debug printing. */
1533 IF_DEBUG(linker, i=1);
1534 if (i == 0) return 1;
1537 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1539 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1541 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1543 fprintf ( stderr, "\n" );
1545 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1547 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1549 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1551 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1553 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1555 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1557 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1559 /* Print the section table. */
1560 fprintf ( stderr, "\n" );
1561 for (i = 0; i < hdr->NumberOfSections; i++) {
1563 COFF_section* sectab_i
1565 myindex ( sizeof_COFF_section, sectab, i );
1572 printName ( sectab_i->Name, strtab );
1582 sectab_i->VirtualSize,
1583 sectab_i->VirtualAddress,
1584 sectab_i->SizeOfRawData,
1585 sectab_i->PointerToRawData,
1586 sectab_i->NumberOfRelocations,
1587 sectab_i->PointerToRelocations,
1588 sectab_i->PointerToRawData
1590 reltab = (COFF_reloc*) (
1591 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1594 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1595 /* If the relocation field (a short) has overflowed, the
1596 * real count can be found in the first reloc entry.
1598 * See Section 4.1 (last para) of the PE spec (rev6.0).
1600 COFF_reloc* rel = (COFF_reloc*)
1601 myindex ( sizeof_COFF_reloc, reltab, 0 );
1602 noRelocs = rel->VirtualAddress;
1605 noRelocs = sectab_i->NumberOfRelocations;
1609 for (; j < noRelocs; j++) {
1611 COFF_reloc* rel = (COFF_reloc*)
1612 myindex ( sizeof_COFF_reloc, reltab, j );
1614 " type 0x%-4x vaddr 0x%-8x name `",
1616 rel->VirtualAddress );
1617 sym = (COFF_symbol*)
1618 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1619 /* Hmm..mysterious looking offset - what's it for? SOF */
1620 printName ( sym->Name, strtab -10 );
1621 fprintf ( stderr, "'\n" );
1624 fprintf ( stderr, "\n" );
1626 fprintf ( stderr, "\n" );
1627 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1628 fprintf ( stderr, "---START of string table---\n");
1629 for (i = 4; i < *(Int32*)strtab; i++) {
1631 fprintf ( stderr, "\n"); else
1632 fprintf( stderr, "%c", strtab[i] );
1634 fprintf ( stderr, "--- END of string table---\n");
1636 fprintf ( stderr, "\n" );
1639 COFF_symbol* symtab_i;
1640 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1641 symtab_i = (COFF_symbol*)
1642 myindex ( sizeof_COFF_symbol, symtab, i );
1648 printName ( symtab_i->Name, strtab );
1657 (Int32)(symtab_i->SectionNumber),
1658 (UInt32)symtab_i->Type,
1659 (UInt32)symtab_i->StorageClass,
1660 (UInt32)symtab_i->NumberOfAuxSymbols
1662 i += symtab_i->NumberOfAuxSymbols;
1666 fprintf ( stderr, "\n" );
1672 ocGetNames_PEi386 ( ObjectCode* oc )
1675 COFF_section* sectab;
1676 COFF_symbol* symtab;
1683 hdr = (COFF_header*)(oc->image);
1684 sectab = (COFF_section*) (
1685 ((UChar*)(oc->image))
1686 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1688 symtab = (COFF_symbol*) (
1689 ((UChar*)(oc->image))
1690 + hdr->PointerToSymbolTable
1692 strtab = ((UChar*)(oc->image))
1693 + hdr->PointerToSymbolTable
1694 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1696 /* Allocate space for any (local, anonymous) .bss sections. */
1698 for (i = 0; i < hdr->NumberOfSections; i++) {
1700 COFF_section* sectab_i
1702 myindex ( sizeof_COFF_section, sectab, i );
1703 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1704 if (sectab_i->VirtualSize == 0) continue;
1705 /* This is a non-empty .bss section. Allocate zeroed space for
1706 it, and set its PointerToRawData field such that oc->image +
1707 PointerToRawData == addr_of_zeroed_space. */
1708 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1709 "ocGetNames_PEi386(anonymous bss)");
1710 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1711 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1712 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1715 /* Copy section information into the ObjectCode. */
1717 for (i = 0; i < hdr->NumberOfSections; i++) {
1723 = SECTIONKIND_OTHER;
1724 COFF_section* sectab_i
1726 myindex ( sizeof_COFF_section, sectab, i );
1727 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1730 /* I'm sure this is the Right Way to do it. However, the
1731 alternative of testing the sectab_i->Name field seems to
1732 work ok with Cygwin.
1734 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1735 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1736 kind = SECTIONKIND_CODE_OR_RODATA;
1739 if (0==strcmp(".text",sectab_i->Name) ||
1740 0==strcmp(".rodata",sectab_i->Name))
1741 kind = SECTIONKIND_CODE_OR_RODATA;
1742 if (0==strcmp(".data",sectab_i->Name) ||
1743 0==strcmp(".bss",sectab_i->Name))
1744 kind = SECTIONKIND_RWDATA;
1746 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1747 sz = sectab_i->SizeOfRawData;
1748 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1750 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1751 end = start + sz - 1;
1753 if (kind == SECTIONKIND_OTHER
1754 /* Ignore sections called which contain stabs debugging
1756 && 0 != strcmp(".stab", sectab_i->Name)
1757 && 0 != strcmp(".stabstr", sectab_i->Name)
1759 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1763 if (kind != SECTIONKIND_OTHER && end >= start) {
1764 addSection(oc, kind, start, end);
1765 addProddableBlock(oc, start, end - start + 1);
1769 /* Copy exported symbols into the ObjectCode. */
1771 oc->n_symbols = hdr->NumberOfSymbols;
1772 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1773 "ocGetNames_PEi386(oc->symbols)");
1774 /* Call me paranoid; I don't care. */
1775 for (i = 0; i < oc->n_symbols; i++)
1776 oc->symbols[i] = NULL;
1780 COFF_symbol* symtab_i;
1781 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1782 symtab_i = (COFF_symbol*)
1783 myindex ( sizeof_COFF_symbol, symtab, i );
1787 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1788 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1789 /* This symbol is global and defined, viz, exported */
1790 /* for MYIMAGE_SYMCLASS_EXTERNAL
1791 && !MYIMAGE_SYM_UNDEFINED,
1792 the address of the symbol is:
1793 address of relevant section + offset in section
1795 COFF_section* sectabent
1796 = (COFF_section*) myindex ( sizeof_COFF_section,
1798 symtab_i->SectionNumber-1 );
1799 addr = ((UChar*)(oc->image))
1800 + (sectabent->PointerToRawData
1804 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1805 && symtab_i->Value > 0) {
1806 /* This symbol isn't in any section at all, ie, global bss.
1807 Allocate zeroed space for it. */
1808 addr = stgCallocBytes(1, symtab_i->Value,
1809 "ocGetNames_PEi386(non-anonymous bss)");
1810 addSection(oc, SECTIONKIND_RWDATA, addr,
1811 ((UChar*)addr) + symtab_i->Value - 1);
1812 addProddableBlock(oc, addr, symtab_i->Value);
1813 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1816 if (addr != NULL ) {
1817 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1818 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1819 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1820 ASSERT(i >= 0 && i < oc->n_symbols);
1821 /* cstring_from_COFF_symbol_name always succeeds. */
1822 oc->symbols[i] = sname;
1823 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1827 "IGNORING symbol %d\n"
1831 printName ( symtab_i->Name, strtab );
1840 (Int32)(symtab_i->SectionNumber),
1841 (UInt32)symtab_i->Type,
1842 (UInt32)symtab_i->StorageClass,
1843 (UInt32)symtab_i->NumberOfAuxSymbols
1848 i += symtab_i->NumberOfAuxSymbols;
1857 ocResolve_PEi386 ( ObjectCode* oc )
1860 COFF_section* sectab;
1861 COFF_symbol* symtab;
1871 /* ToDo: should be variable-sized? But is at least safe in the
1872 sense of buffer-overrun-proof. */
1874 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1876 hdr = (COFF_header*)(oc->image);
1877 sectab = (COFF_section*) (
1878 ((UChar*)(oc->image))
1879 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1881 symtab = (COFF_symbol*) (
1882 ((UChar*)(oc->image))
1883 + hdr->PointerToSymbolTable
1885 strtab = ((UChar*)(oc->image))
1886 + hdr->PointerToSymbolTable
1887 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1889 for (i = 0; i < hdr->NumberOfSections; i++) {
1890 COFF_section* sectab_i
1892 myindex ( sizeof_COFF_section, sectab, i );
1895 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1898 /* Ignore sections called which contain stabs debugging
1900 if (0 == strcmp(".stab", sectab_i->Name)
1901 || 0 == strcmp(".stabstr", sectab_i->Name))
1904 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1905 /* If the relocation field (a short) has overflowed, the
1906 * real count can be found in the first reloc entry.
1908 * See Section 4.1 (last para) of the PE spec (rev6.0).
1910 COFF_reloc* rel = (COFF_reloc*)
1911 myindex ( sizeof_COFF_reloc, reltab, 0 );
1912 noRelocs = rel->VirtualAddress;
1913 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1916 noRelocs = sectab_i->NumberOfRelocations;
1921 for (; j < noRelocs; j++) {
1923 COFF_reloc* reltab_j
1925 myindex ( sizeof_COFF_reloc, reltab, j );
1927 /* the location to patch */
1929 ((UChar*)(oc->image))
1930 + (sectab_i->PointerToRawData
1931 + reltab_j->VirtualAddress
1932 - sectab_i->VirtualAddress )
1934 /* the existing contents of pP */
1936 /* the symbol to connect to */
1937 sym = (COFF_symbol*)
1938 myindex ( sizeof_COFF_symbol,
1939 symtab, reltab_j->SymbolTableIndex );
1942 "reloc sec %2d num %3d: type 0x%-4x "
1943 "vaddr 0x%-8x name `",
1945 (UInt32)reltab_j->Type,
1946 reltab_j->VirtualAddress );
1947 printName ( sym->Name, strtab );
1948 fprintf ( stderr, "'\n" ));
1950 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1951 COFF_section* section_sym
1952 = findPEi386SectionCalled ( oc, sym->Name );
1954 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1957 S = ((UInt32)(oc->image))
1958 + (section_sym->PointerToRawData
1961 copyName ( sym->Name, strtab, symbol, 1000-1 );
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 zapTrailingAtSign ( symbol );
1967 (void*)S = lookupLocalSymbol( oc, symbol );
1968 if ((void*)S != NULL) goto foundit;
1969 (void*)S = lookupSymbol( symbol );
1970 if ((void*)S != NULL) goto foundit;
1971 /* Newline first because the interactive linker has printed "linking..." */
1972 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1976 checkProddableBlock(oc, pP);
1977 switch (reltab_j->Type) {
1978 case MYIMAGE_REL_I386_DIR32:
1981 case MYIMAGE_REL_I386_REL32:
1982 /* Tricky. We have to insert a displacement at
1983 pP which, when added to the PC for the _next_
1984 insn, gives the address of the target (S).
1985 Problem is to know the address of the next insn
1986 when we only know pP. We assume that this
1987 literal field is always the last in the insn,
1988 so that the address of the next insn is pP+4
1989 -- hence the constant 4.
1990 Also I don't know if A should be added, but so
1991 far it has always been zero.
1994 *pP = S - ((UInt32)pP) - 4;
1997 belch("%s: unhandled PEi386 relocation type %d",
1998 oc->fileName, reltab_j->Type);
2005 IF_DEBUG(linker, belch("completed %s", oc->fileName));
2009 #endif /* defined(OBJFORMAT_PEi386) */
2012 /* --------------------------------------------------------------------------
2014 * ------------------------------------------------------------------------*/
2016 #if defined(OBJFORMAT_ELF)
2021 #if defined(sparc_TARGET_ARCH)
2022 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2023 #elif defined(i386_TARGET_ARCH)
2024 # define ELF_TARGET_386 /* Used inside <elf.h> */
2025 #elif defined(x86_64_TARGET_ARCH)
2026 # define ELF_TARGET_X64_64
2028 #elif defined (ia64_TARGET_ARCH)
2029 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2031 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2032 # define ELF_NEED_GOT /* needs Global Offset Table */
2033 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2036 #if !defined(openbsd_TARGET_OS)
2039 /* openbsd elf has things in different places, with diff names */
2040 #include <elf_abi.h>
2041 #include <machine/reloc.h>
2042 #define R_386_32 RELOC_32
2043 #define R_386_PC32 RELOC_PC32
2047 * Define a set of types which can be used for both ELF32 and ELF64
2051 #define ELFCLASS ELFCLASS64
2052 #define Elf_Addr Elf64_Addr
2053 #define Elf_Word Elf64_Word
2054 #define Elf_Sword Elf64_Sword
2055 #define Elf_Ehdr Elf64_Ehdr
2056 #define Elf_Phdr Elf64_Phdr
2057 #define Elf_Shdr Elf64_Shdr
2058 #define Elf_Sym Elf64_Sym
2059 #define Elf_Rel Elf64_Rel
2060 #define Elf_Rela Elf64_Rela
2061 #define ELF_ST_TYPE ELF64_ST_TYPE
2062 #define ELF_ST_BIND ELF64_ST_BIND
2063 #define ELF_R_TYPE ELF64_R_TYPE
2064 #define ELF_R_SYM ELF64_R_SYM
2066 #define ELFCLASS ELFCLASS32
2067 #define Elf_Addr Elf32_Addr
2068 #define Elf_Word Elf32_Word
2069 #define Elf_Sword Elf32_Sword
2070 #define Elf_Ehdr Elf32_Ehdr
2071 #define Elf_Phdr Elf32_Phdr
2072 #define Elf_Shdr Elf32_Shdr
2073 #define Elf_Sym Elf32_Sym
2074 #define Elf_Rel Elf32_Rel
2075 #define Elf_Rela Elf32_Rela
2077 #define ELF_ST_TYPE ELF32_ST_TYPE
2080 #define ELF_ST_BIND ELF32_ST_BIND
2083 #define ELF_R_TYPE ELF32_R_TYPE
2086 #define ELF_R_SYM ELF32_R_SYM
2092 * Functions to allocate entries in dynamic sections. Currently we simply
2093 * preallocate a large number, and we don't check if a entry for the given
2094 * target already exists (a linear search is too slow). Ideally these
2095 * entries would be associated with symbols.
2098 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2099 #define GOT_SIZE 0x20000
2100 #define FUNCTION_TABLE_SIZE 0x10000
2101 #define PLT_SIZE 0x08000
2104 static Elf_Addr got[GOT_SIZE];
2105 static unsigned int gotIndex;
2106 static Elf_Addr gp_val = (Elf_Addr)got;
2109 allocateGOTEntry(Elf_Addr target)
2113 if (gotIndex >= GOT_SIZE)
2114 barf("Global offset table overflow");
2116 entry = &got[gotIndex++];
2118 return (Elf_Addr)entry;
2122 #ifdef ELF_FUNCTION_DESC
2128 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2129 static unsigned int functionTableIndex;
2132 allocateFunctionDesc(Elf_Addr target)
2134 FunctionDesc *entry;
2136 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2137 barf("Function table overflow");
2139 entry = &functionTable[functionTableIndex++];
2141 entry->gp = (Elf_Addr)gp_val;
2142 return (Elf_Addr)entry;
2146 copyFunctionDesc(Elf_Addr target)
2148 FunctionDesc *olddesc = (FunctionDesc *)target;
2149 FunctionDesc *newdesc;
2151 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2152 newdesc->gp = olddesc->gp;
2153 return (Elf_Addr)newdesc;
2158 #ifdef ia64_TARGET_ARCH
2159 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2160 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2162 static unsigned char plt_code[] =
2164 /* taken from binutils bfd/elfxx-ia64.c */
2165 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2166 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2167 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2168 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2169 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2170 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2173 /* If we can't get to the function descriptor via gp, take a local copy of it */
2174 #define PLT_RELOC(code, target) { \
2175 Elf64_Sxword rel_value = target - gp_val; \
2176 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2177 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2179 ia64_reloc_gprel22((Elf_Addr)code, target); \
2184 unsigned char code[sizeof(plt_code)];
2188 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2190 PLTEntry *plt = (PLTEntry *)oc->plt;
2193 if (oc->pltIndex >= PLT_SIZE)
2194 barf("Procedure table overflow");
2196 entry = &plt[oc->pltIndex++];
2197 memcpy(entry->code, plt_code, sizeof(entry->code));
2198 PLT_RELOC(entry->code, target);
2199 return (Elf_Addr)entry;
2205 return (PLT_SIZE * sizeof(PLTEntry));
2211 * Generic ELF functions
2215 findElfSection ( void* objImage, Elf_Word sh_type )
2217 char* ehdrC = (char*)objImage;
2218 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2219 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2220 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2224 for (i = 0; i < ehdr->e_shnum; i++) {
2225 if (shdr[i].sh_type == sh_type
2226 /* Ignore the section header's string table. */
2227 && i != ehdr->e_shstrndx
2228 /* Ignore string tables named .stabstr, as they contain
2230 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2232 ptr = ehdrC + shdr[i].sh_offset;
2239 #if defined(ia64_TARGET_ARCH)
2241 findElfSegment ( void* objImage, Elf_Addr vaddr )
2243 char* ehdrC = (char*)objImage;
2244 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2245 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2246 Elf_Addr segaddr = 0;
2249 for (i = 0; i < ehdr->e_phnum; i++) {
2250 segaddr = phdr[i].p_vaddr;
2251 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2259 ocVerifyImage_ELF ( ObjectCode* oc )
2263 int i, j, nent, nstrtab, nsymtabs;
2267 char* ehdrC = (char*)(oc->image);
2268 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2270 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2271 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2272 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2273 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2274 belch("%s: not an ELF object", oc->fileName);
2278 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2279 belch("%s: unsupported ELF format", oc->fileName);
2283 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2284 IF_DEBUG(linker,belch( "Is little-endian" ));
2286 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2287 IF_DEBUG(linker,belch( "Is big-endian" ));
2289 belch("%s: unknown endiannness", oc->fileName);
2293 if (ehdr->e_type != ET_REL) {
2294 belch("%s: not a relocatable object (.o) file", oc->fileName);
2297 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2299 IF_DEBUG(linker,belch( "Architecture is " ));
2300 switch (ehdr->e_machine) {
2301 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2302 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2304 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2306 default: IF_DEBUG(linker,belch( "unknown" ));
2307 belch("%s: unknown architecture", oc->fileName);
2311 IF_DEBUG(linker,belch(
2312 "\nSection header table: start %d, n_entries %d, ent_size %d",
2313 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2315 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2317 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2319 if (ehdr->e_shstrndx == SHN_UNDEF) {
2320 belch("%s: no section header string table", oc->fileName);
2323 IF_DEBUG(linker,belch( "Section header string table is section %d",
2325 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2328 for (i = 0; i < ehdr->e_shnum; i++) {
2329 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2330 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2331 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2332 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2333 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2334 ehdrC + shdr[i].sh_offset,
2335 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2337 if (shdr[i].sh_type == SHT_REL) {
2338 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2339 } else if (shdr[i].sh_type == SHT_RELA) {
2340 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2342 IF_DEBUG(linker,fprintf(stderr," "));
2345 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2349 IF_DEBUG(linker,belch( "\nString tables" ));
2352 for (i = 0; i < ehdr->e_shnum; i++) {
2353 if (shdr[i].sh_type == SHT_STRTAB
2354 /* Ignore the section header's string table. */
2355 && i != ehdr->e_shstrndx
2356 /* Ignore string tables named .stabstr, as they contain
2358 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2360 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2361 strtab = ehdrC + shdr[i].sh_offset;
2366 belch("%s: no string tables, or too many", oc->fileName);
2371 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2372 for (i = 0; i < ehdr->e_shnum; i++) {
2373 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2374 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2376 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2377 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2378 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2380 shdr[i].sh_size % sizeof(Elf_Sym)
2382 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2383 belch("%s: non-integral number of symbol table entries", oc->fileName);
2386 for (j = 0; j < nent; j++) {
2387 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2388 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2389 (int)stab[j].st_shndx,
2390 (int)stab[j].st_size,
2391 (char*)stab[j].st_value ));
2393 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2394 switch (ELF_ST_TYPE(stab[j].st_info)) {
2395 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2396 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2397 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2398 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2399 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2400 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2402 IF_DEBUG(linker,fprintf(stderr, " " ));
2404 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2405 switch (ELF_ST_BIND(stab[j].st_info)) {
2406 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2407 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2408 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2409 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2411 IF_DEBUG(linker,fprintf(stderr, " " ));
2413 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2417 if (nsymtabs == 0) {
2418 belch("%s: didn't find any symbol tables", oc->fileName);
2427 ocGetNames_ELF ( ObjectCode* oc )
2432 char* ehdrC = (char*)(oc->image);
2433 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2434 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2435 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2437 ASSERT(symhash != NULL);
2440 belch("%s: no strtab", oc->fileName);
2445 for (i = 0; i < ehdr->e_shnum; i++) {
2446 /* Figure out what kind of section it is. Logic derived from
2447 Figure 1.14 ("Special Sections") of the ELF document
2448 ("Portable Formats Specification, Version 1.1"). */
2449 Elf_Shdr hdr = shdr[i];
2450 SectionKind kind = SECTIONKIND_OTHER;
2453 if (hdr.sh_type == SHT_PROGBITS
2454 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2455 /* .text-style section */
2456 kind = SECTIONKIND_CODE_OR_RODATA;
2459 if (hdr.sh_type == SHT_PROGBITS
2460 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2461 /* .data-style section */
2462 kind = SECTIONKIND_RWDATA;
2465 if (hdr.sh_type == SHT_PROGBITS
2466 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2467 /* .rodata-style section */
2468 kind = SECTIONKIND_CODE_OR_RODATA;
2471 if (hdr.sh_type == SHT_NOBITS
2472 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2473 /* .bss-style section */
2474 kind = SECTIONKIND_RWDATA;
2478 if (is_bss && shdr[i].sh_size > 0) {
2479 /* This is a non-empty .bss section. Allocate zeroed space for
2480 it, and set its .sh_offset field such that
2481 ehdrC + .sh_offset == addr_of_zeroed_space. */
2482 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2483 "ocGetNames_ELF(BSS)");
2484 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2486 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2487 zspace, shdr[i].sh_size);
2491 /* fill in the section info */
2492 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2493 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2494 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2495 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2498 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2500 /* copy stuff into this module's object symbol table */
2501 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2502 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2504 oc->n_symbols = nent;
2505 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2506 "ocGetNames_ELF(oc->symbols)");
2508 for (j = 0; j < nent; j++) {
2510 char isLocal = FALSE; /* avoids uninit-var warning */
2512 char* nm = strtab + stab[j].st_name;
2513 int secno = stab[j].st_shndx;
2515 /* Figure out if we want to add it; if so, set ad to its
2516 address. Otherwise leave ad == NULL. */
2518 if (secno == SHN_COMMON) {
2520 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2522 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2523 stab[j].st_size, nm);
2525 /* Pointless to do addProddableBlock() for this area,
2526 since the linker should never poke around in it. */
2529 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2530 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2532 /* and not an undefined symbol */
2533 && stab[j].st_shndx != SHN_UNDEF
2534 /* and not in a "special section" */
2535 && stab[j].st_shndx < SHN_LORESERVE
2537 /* and it's a not a section or string table or anything silly */
2538 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2539 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2540 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2543 /* Section 0 is the undefined section, hence > and not >=. */
2544 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2546 if (shdr[secno].sh_type == SHT_NOBITS) {
2547 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2548 stab[j].st_size, stab[j].st_value, nm);
2551 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2552 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2555 #ifdef ELF_FUNCTION_DESC
2556 /* dlsym() and the initialisation table both give us function
2557 * descriptors, so to be consistent we store function descriptors
2558 * in the symbol table */
2559 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2560 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2562 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2563 ad, oc->fileName, nm ));
2568 /* And the decision is ... */
2572 oc->symbols[j] = nm;
2575 /* Ignore entirely. */
2577 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2581 IF_DEBUG(linker,belch( "skipping `%s'",
2582 strtab + stab[j].st_name ));
2585 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2586 (int)ELF_ST_BIND(stab[j].st_info),
2587 (int)ELF_ST_TYPE(stab[j].st_info),
2588 (int)stab[j].st_shndx,
2589 strtab + stab[j].st_name
2592 oc->symbols[j] = NULL;
2601 /* Do ELF relocations which lack an explicit addend. All x86-linux
2602 relocations appear to be of this form. */
2604 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2605 Elf_Shdr* shdr, int shnum,
2606 Elf_Sym* stab, char* strtab )
2611 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2612 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2613 int target_shndx = shdr[shnum].sh_info;
2614 int symtab_shndx = shdr[shnum].sh_link;
2616 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2617 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2618 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2619 target_shndx, symtab_shndx ));
2621 for (j = 0; j < nent; j++) {
2622 Elf_Addr offset = rtab[j].r_offset;
2623 Elf_Addr info = rtab[j].r_info;
2625 Elf_Addr P = ((Elf_Addr)targ) + offset;
2626 Elf_Word* pP = (Elf_Word*)P;
2631 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2632 j, (void*)offset, (void*)info ));
2634 IF_DEBUG(linker,belch( " ZERO" ));
2637 Elf_Sym sym = stab[ELF_R_SYM(info)];
2638 /* First see if it is a local symbol. */
2639 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2640 /* Yes, so we can get the address directly from the ELF symbol
2642 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2644 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2645 + stab[ELF_R_SYM(info)].st_value);
2648 /* No, so look up the name in our global table. */
2649 symbol = strtab + sym.st_name;
2650 (void*)S = lookupSymbol( symbol );
2653 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2656 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2659 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2660 (void*)P, (void*)S, (void*)A ));
2661 checkProddableBlock ( oc, pP );
2665 switch (ELF_R_TYPE(info)) {
2666 # ifdef i386_TARGET_ARCH
2667 case R_386_32: *pP = value; break;
2668 case R_386_PC32: *pP = value - P; break;
2671 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2672 oc->fileName, ELF_R_TYPE(info));
2680 /* Do ELF relocations for which explicit addends are supplied.
2681 sparc-solaris relocations appear to be of this form. */
2683 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2684 Elf_Shdr* shdr, int shnum,
2685 Elf_Sym* stab, char* strtab )
2690 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2691 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2692 int target_shndx = shdr[shnum].sh_info;
2693 int symtab_shndx = shdr[shnum].sh_link;
2695 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2696 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2697 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2698 target_shndx, symtab_shndx ));
2700 for (j = 0; j < nent; j++) {
2701 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2702 /* This #ifdef only serves to avoid unused-var warnings. */
2703 Elf_Addr offset = rtab[j].r_offset;
2704 Elf_Addr P = targ + offset;
2706 Elf_Addr info = rtab[j].r_info;
2707 Elf_Addr A = rtab[j].r_addend;
2710 # if defined(sparc_TARGET_ARCH)
2711 Elf_Word* pP = (Elf_Word*)P;
2713 # elif defined(ia64_TARGET_ARCH)
2714 Elf64_Xword *pP = (Elf64_Xword *)P;
2718 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2719 j, (void*)offset, (void*)info,
2722 IF_DEBUG(linker,belch( " ZERO" ));
2725 Elf_Sym sym = stab[ELF_R_SYM(info)];
2726 /* First see if it is a local symbol. */
2727 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2728 /* Yes, so we can get the address directly from the ELF symbol
2730 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2732 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2733 + stab[ELF_R_SYM(info)].st_value);
2734 #ifdef ELF_FUNCTION_DESC
2735 /* Make a function descriptor for this function */
2736 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2737 S = allocateFunctionDesc(S + A);
2742 /* No, so look up the name in our global table. */
2743 symbol = strtab + sym.st_name;
2744 (void*)S = lookupSymbol( symbol );
2746 #ifdef ELF_FUNCTION_DESC
2747 /* If a function, already a function descriptor - we would
2748 have to copy it to add an offset. */
2749 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2750 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2754 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2757 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2760 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2761 (void*)P, (void*)S, (void*)A ));
2762 /* checkProddableBlock ( oc, (void*)P ); */
2766 switch (ELF_R_TYPE(info)) {
2767 # if defined(sparc_TARGET_ARCH)
2768 case R_SPARC_WDISP30:
2769 w1 = *pP & 0xC0000000;
2770 w2 = (Elf_Word)((value - P) >> 2);
2771 ASSERT((w2 & 0xC0000000) == 0);
2776 w1 = *pP & 0xFFC00000;
2777 w2 = (Elf_Word)(value >> 10);
2778 ASSERT((w2 & 0xFFC00000) == 0);
2784 w2 = (Elf_Word)(value & 0x3FF);
2785 ASSERT((w2 & ~0x3FF) == 0);
2789 /* According to the Sun documentation:
2791 This relocation type resembles R_SPARC_32, except it refers to an
2792 unaligned word. That is, the word to be relocated must be treated
2793 as four separate bytes with arbitrary alignment, not as a word
2794 aligned according to the architecture requirements.
2796 (JRS: which means that freeloading on the R_SPARC_32 case
2797 is probably wrong, but hey ...)
2801 w2 = (Elf_Word)value;
2804 # elif defined(ia64_TARGET_ARCH)
2805 case R_IA64_DIR64LSB:
2806 case R_IA64_FPTR64LSB:
2809 case R_IA64_PCREL64LSB:
2812 case R_IA64_SEGREL64LSB:
2813 addr = findElfSegment(ehdrC, value);
2816 case R_IA64_GPREL22:
2817 ia64_reloc_gprel22(P, value);
2819 case R_IA64_LTOFF22:
2820 case R_IA64_LTOFF22X:
2821 case R_IA64_LTOFF_FPTR22:
2822 addr = allocateGOTEntry(value);
2823 ia64_reloc_gprel22(P, addr);
2825 case R_IA64_PCREL21B:
2826 ia64_reloc_pcrel21(P, S, oc);
2829 /* This goes with R_IA64_LTOFF22X and points to the load to
2830 * convert into a move. We don't implement relaxation. */
2834 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2835 oc->fileName, ELF_R_TYPE(info));
2844 ocResolve_ELF ( ObjectCode* oc )
2848 Elf_Sym* stab = NULL;
2849 char* ehdrC = (char*)(oc->image);
2850 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2851 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2852 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2854 /* first find "the" symbol table */
2855 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2857 /* also go find the string table */
2858 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2860 if (stab == NULL || strtab == NULL) {
2861 belch("%s: can't find string or symbol table", oc->fileName);
2865 /* Process the relocation sections. */
2866 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2868 /* Skip sections called ".rel.stab". These appear to contain
2869 relocation entries that, when done, make the stabs debugging
2870 info point at the right places. We ain't interested in all
2872 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2875 if (shdr[shnum].sh_type == SHT_REL ) {
2876 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2877 shnum, stab, strtab );
2881 if (shdr[shnum].sh_type == SHT_RELA) {
2882 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2883 shnum, stab, strtab );
2888 /* Free the local symbol table; we won't need it again. */
2889 freeHashTable(oc->lochash, NULL);
2897 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2898 * at the front. The following utility functions pack and unpack instructions, and
2899 * take care of the most common relocations.
2902 #ifdef ia64_TARGET_ARCH
2905 ia64_extract_instruction(Elf64_Xword *target)
2908 int slot = (Elf_Addr)target & 3;
2909 (Elf_Addr)target &= ~3;
2917 return ((w1 >> 5) & 0x1ffffffffff);
2919 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2923 barf("ia64_extract_instruction: invalid slot %p", target);
2928 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2930 int slot = (Elf_Addr)target & 3;
2931 (Elf_Addr)target &= ~3;
2936 *target |= value << 5;
2939 *target |= value << 46;
2940 *(target+1) |= value >> 18;
2943 *(target+1) |= value << 23;
2949 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2951 Elf64_Xword instruction;
2952 Elf64_Sxword rel_value;
2954 rel_value = value - gp_val;
2955 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2956 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2958 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2959 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2960 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2961 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2962 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2963 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2967 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2969 Elf64_Xword instruction;
2970 Elf64_Sxword rel_value;
2973 entry = allocatePLTEntry(value, oc);
2975 rel_value = (entry >> 4) - (target >> 4);
2976 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2977 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2979 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2980 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2981 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2982 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2989 /* --------------------------------------------------------------------------
2991 * ------------------------------------------------------------------------*/
2993 #if defined(OBJFORMAT_MACHO)
2996 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2997 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2999 I hereby formally apologize for the hackish nature of this code.
3000 Things that need to be done:
3001 *) get common symbols and .bss sections to work properly.
3002 Haskell modules seem to work, but C modules can cause problems
3003 *) implement ocVerifyImage_MachO
3004 *) add more sanity checks. The current code just has to segfault if there's a
3008 static int ocVerifyImage_MachO(ObjectCode* oc)
3010 // FIXME: do some verifying here
3014 static int resolveImports(
3017 struct symtab_command *symLC,
3018 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3019 unsigned long *indirectSyms,
3020 struct nlist *nlist)
3024 for(i=0;i*4<sect->size;i++)
3026 // according to otool, reserved1 contains the first index into the indirect symbol table
3027 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3028 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3031 if((symbol->n_type & N_TYPE) == N_UNDF
3032 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3033 addr = (void*) (symbol->n_value);
3034 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3037 addr = lookupSymbol(nm);
3040 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3044 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3045 ((void**)(image + sect->offset))[i] = addr;
3051 static int relocateSection(
3054 struct symtab_command *symLC, struct nlist *nlist,
3055 struct section* sections, struct section *sect)
3057 struct relocation_info *relocs;
3060 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3062 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3066 relocs = (struct relocation_info*) (image + sect->reloff);
3070 if(relocs[i].r_address & R_SCATTERED)
3072 struct scattered_relocation_info *scat =
3073 (struct scattered_relocation_info*) &relocs[i];
3077 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3079 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3081 checkProddableBlock(oc,word);
3082 *word = scat->r_value + sect->offset + ((long) image);
3086 continue; // FIXME: I hope it's OK to ignore all the others.
3090 struct relocation_info *reloc = &relocs[i];
3091 if(reloc->r_pcrel && !reloc->r_extern)
3094 if(reloc->r_length == 2)
3096 unsigned long word = 0;
3098 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3099 checkProddableBlock(oc,wordPtr);
3101 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3105 else if(reloc->r_type == PPC_RELOC_LO16)
3107 word = ((unsigned short*) wordPtr)[1];
3108 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3110 else if(reloc->r_type == PPC_RELOC_HI16)
3112 word = ((unsigned short*) wordPtr)[1] << 16;
3113 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3115 else if(reloc->r_type == PPC_RELOC_HA16)
3117 word = ((unsigned short*) wordPtr)[1] << 16;
3118 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3120 else if(reloc->r_type == PPC_RELOC_BR24)
3123 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3127 if(!reloc->r_extern)
3130 sections[reloc->r_symbolnum-1].offset
3131 - sections[reloc->r_symbolnum-1].addr
3138 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3139 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3140 word = (unsigned long) (lookupSymbol(nm));
3143 belch("\nunknown symbol `%s'", nm);
3148 word -= ((long)image) + sect->offset + reloc->r_address;
3151 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3156 else if(reloc->r_type == PPC_RELOC_LO16)
3158 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3161 else if(reloc->r_type == PPC_RELOC_HI16)
3163 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3166 else if(reloc->r_type == PPC_RELOC_HA16)
3168 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3169 + ((word & (1<<15)) ? 1 : 0);
3172 else if(reloc->r_type == PPC_RELOC_BR24)
3174 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3178 barf("\nunknown relocation %d",reloc->r_type);
3185 static int ocGetNames_MachO(ObjectCode* oc)
3187 char *image = (char*) oc->image;
3188 struct mach_header *header = (struct mach_header*) image;
3189 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3190 unsigned i,curSymbol;
3191 struct segment_command *segLC = NULL;
3192 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3193 struct symtab_command *symLC = NULL;
3194 struct dysymtab_command *dsymLC = NULL;
3195 struct nlist *nlist;
3196 unsigned long commonSize = 0;
3197 char *commonStorage = NULL;
3198 unsigned long commonCounter;
3200 for(i=0;i<header->ncmds;i++)
3202 if(lc->cmd == LC_SEGMENT)
3203 segLC = (struct segment_command*) lc;
3204 else if(lc->cmd == LC_SYMTAB)
3205 symLC = (struct symtab_command*) lc;
3206 else if(lc->cmd == LC_DYSYMTAB)
3207 dsymLC = (struct dysymtab_command*) lc;
3208 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3211 sections = (struct section*) (segLC+1);
3212 nlist = (struct nlist*) (image + symLC->symoff);
3214 for(i=0;i<segLC->nsects;i++)
3216 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3217 la_ptrs = §ions[i];
3218 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3219 nl_ptrs = §ions[i];
3221 // for now, only add __text and __const to the sections table
3222 else if(!strcmp(sections[i].sectname,"__text"))
3223 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3224 (void*) (image + sections[i].offset),
3225 (void*) (image + sections[i].offset + sections[i].size));
3226 else if(!strcmp(sections[i].sectname,"__const"))
3227 addSection(oc, SECTIONKIND_RWDATA,
3228 (void*) (image + sections[i].offset),
3229 (void*) (image + sections[i].offset + sections[i].size));
3230 else if(!strcmp(sections[i].sectname,"__data"))
3231 addSection(oc, SECTIONKIND_RWDATA,
3232 (void*) (image + sections[i].offset),
3233 (void*) (image + sections[i].offset + sections[i].size));
3235 if(sections[i].size > 0) // size 0 segments do exist
3236 addProddableBlock(oc, (void*) (image + sections[i].offset),
3240 // count external symbols defined here
3242 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3244 if((nlist[i].n_type & N_TYPE) == N_SECT)
3247 for(i=0;i<symLC->nsyms;i++)
3249 if((nlist[i].n_type & N_TYPE) == N_UNDF
3250 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3252 commonSize += nlist[i].n_value;
3256 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3257 "ocGetNames_MachO(oc->symbols)");
3259 // insert symbols into hash table
3260 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3262 if((nlist[i].n_type & N_TYPE) == N_SECT)
3264 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3265 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3266 sections[nlist[i].n_sect-1].offset
3267 - sections[nlist[i].n_sect-1].addr
3268 + nlist[i].n_value);
3269 oc->symbols[curSymbol++] = nm;
3273 // insert local symbols into lochash
3274 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3276 if((nlist[i].n_type & N_TYPE) == N_SECT)
3278 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3279 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3280 sections[nlist[i].n_sect-1].offset
3281 - sections[nlist[i].n_sect-1].addr
3282 + nlist[i].n_value);
3287 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3288 commonCounter = (unsigned long)commonStorage;
3289 for(i=0;i<symLC->nsyms;i++)
3291 if((nlist[i].n_type & N_TYPE) == N_UNDF
3292 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3294 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3295 unsigned long sz = nlist[i].n_value;
3297 nlist[i].n_value = commonCounter;
3299 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3300 oc->symbols[curSymbol++] = nm;
3302 commonCounter += sz;
3308 static int ocResolve_MachO(ObjectCode* oc)
3310 char *image = (char*) oc->image;
3311 struct mach_header *header = (struct mach_header*) image;
3312 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3314 struct segment_command *segLC = NULL;
3315 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3316 struct symtab_command *symLC = NULL;
3317 struct dysymtab_command *dsymLC = NULL;
3318 struct nlist *nlist;
3319 unsigned long *indirectSyms;
3321 for(i=0;i<header->ncmds;i++)
3323 if(lc->cmd == LC_SEGMENT)
3324 segLC = (struct segment_command*) lc;
3325 else if(lc->cmd == LC_SYMTAB)
3326 symLC = (struct symtab_command*) lc;
3327 else if(lc->cmd == LC_DYSYMTAB)
3328 dsymLC = (struct dysymtab_command*) lc;
3329 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3332 sections = (struct section*) (segLC+1);
3333 nlist = (struct nlist*) (image + symLC->symoff);
3335 for(i=0;i<segLC->nsects;i++)
3337 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3338 la_ptrs = §ions[i];
3339 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3340 nl_ptrs = §ions[i];
3343 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3346 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3349 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3352 for(i=0;i<segLC->nsects;i++)
3354 if(!relocateSection(oc,image,symLC,nlist,sections,§ions[i]))
3358 /* Free the local symbol table; we won't need it again. */
3359 freeHashTable(oc->lochash, NULL);
3365 * The Mach-O object format uses leading underscores. But not everywhere.
3366 * There is a small number of runtime support functions defined in
3367 * libcc_dynamic.a whose name does not have a leading underscore.
3368 * As a consequence, we can't get their address from C code.
3369 * We have to use inline assembler just to take the address of a function.
3373 static void machoInitSymbolsWithoutUnderscore()
3379 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3380 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3382 RTS_MACHO_NOUNDERLINE_SYMBOLS