1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.121 2003/06/09 13:17:40 matthewc 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)
63 # define OBJFORMAT_ELF
64 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
65 # define OBJFORMAT_PEi386
68 #elif defined(darwin_TARGET_OS)
69 # include <mach-o/ppc/reloc.h>
70 # define OBJFORMAT_MACHO
71 # include <mach-o/loader.h>
72 # include <mach-o/nlist.h>
73 # include <mach-o/reloc.h>
76 /* Hash table mapping symbol names to Symbol */
77 static /*Str*/HashTable *symhash;
79 /* List of currently loaded objects */
80 ObjectCode *objects = NULL; /* initially empty */
82 #if defined(OBJFORMAT_ELF)
83 static int ocVerifyImage_ELF ( ObjectCode* oc );
84 static int ocGetNames_ELF ( ObjectCode* oc );
85 static int ocResolve_ELF ( ObjectCode* oc );
86 #elif defined(OBJFORMAT_PEi386)
87 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
88 static int ocGetNames_PEi386 ( ObjectCode* oc );
89 static int ocResolve_PEi386 ( ObjectCode* oc );
90 #elif defined(OBJFORMAT_MACHO)
91 static int ocVerifyImage_MachO ( ObjectCode* oc );
92 static int ocGetNames_MachO ( ObjectCode* oc );
93 static int ocResolve_MachO ( ObjectCode* oc );
95 static void machoInitSymbolsWithoutUnderscore( void );
98 /* -----------------------------------------------------------------------------
99 * Built-in symbols from the RTS
102 typedef struct _RtsSymbolVal {
109 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
111 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
112 SymX(makeStableNamezh_fast) \
113 SymX(finalizzeWeakzh_fast)
115 /* These are not available in GUM!!! -- HWL */
116 #define Maybe_ForeignObj
117 #define Maybe_Stable_Names
120 #if !defined (mingw32_TARGET_OS)
121 #define RTS_POSIX_ONLY_SYMBOLS \
122 SymX(stg_sig_install) \
126 #if defined (cygwin32_TARGET_OS)
127 #define RTS_MINGW_ONLY_SYMBOLS /**/
128 /* Don't have the ability to read import libs / archives, so
129 * we have to stupidly list a lot of what libcygwin.a
132 #define RTS_CYGWIN_ONLY_SYMBOLS \
210 #elif !defined(mingw32_TARGET_OS)
211 #define RTS_MINGW_ONLY_SYMBOLS /**/
212 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
213 #else /* defined(mingw32_TARGET_OS) */
214 #define RTS_POSIX_ONLY_SYMBOLS /**/
215 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
217 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
219 #define RTS_MINGW_EXTRA_SYMS \
220 Sym(_imp____mb_cur_max) \
223 #define RTS_MINGW_EXTRA_SYMS
226 /* These are statically linked from the mingw libraries into the ghc
227 executable, so we have to employ this hack. */
228 #define RTS_MINGW_ONLY_SYMBOLS \
229 SymX(asyncReadzh_fast) \
230 SymX(asyncWritezh_fast) \
242 SymX(getservbyname) \
243 SymX(getservbyport) \
244 SymX(getprotobynumber) \
245 SymX(getprotobyname) \
246 SymX(gethostbyname) \
247 SymX(gethostbyaddr) \
282 Sym(_imp___timezone) \
290 RTS_MINGW_EXTRA_SYMS \
295 # define MAIN_CAP_SYM SymX(MainCapability)
297 # define MAIN_CAP_SYM
300 #define RTS_SYMBOLS \
304 SymX(stg_enter_info) \
305 SymX(stg_enter_ret) \
306 SymX(stg_gc_void_info) \
307 SymX(__stg_gc_enter_1) \
308 SymX(stg_gc_noregs) \
309 SymX(stg_gc_unpt_r1_info) \
310 SymX(stg_gc_unpt_r1) \
311 SymX(stg_gc_unbx_r1_info) \
312 SymX(stg_gc_unbx_r1) \
313 SymX(stg_gc_f1_info) \
315 SymX(stg_gc_d1_info) \
317 SymX(stg_gc_l1_info) \
320 SymX(stg_gc_fun_info) \
321 SymX(stg_gc_fun_ret) \
323 SymX(stg_gc_gen_info) \
324 SymX(stg_gc_gen_hp) \
326 SymX(stg_gen_yield) \
327 SymX(stg_yield_noregs) \
328 SymX(stg_yield_to_interpreter) \
329 SymX(stg_gen_block) \
330 SymX(stg_block_noregs) \
332 SymX(stg_block_takemvar) \
333 SymX(stg_block_putmvar) \
334 SymX(stg_seq_frame_info) \
337 SymX(MallocFailHook) \
339 SymX(OutOfHeapHook) \
340 SymX(PatErrorHdrHook) \
341 SymX(PostTraceHook) \
343 SymX(StackOverflowHook) \
344 SymX(__encodeDouble) \
345 SymX(__encodeFloat) \
348 SymX(__gmpz_cmp_si) \
349 SymX(__gmpz_cmp_ui) \
350 SymX(__gmpz_get_si) \
351 SymX(__gmpz_get_ui) \
352 SymX(__int_encodeDouble) \
353 SymX(__int_encodeFloat) \
354 SymX(andIntegerzh_fast) \
355 SymX(blockAsyncExceptionszh_fast) \
358 SymX(complementIntegerzh_fast) \
359 SymX(cmpIntegerzh_fast) \
360 SymX(cmpIntegerIntzh_fast) \
361 SymX(createAdjustor) \
362 SymX(decodeDoublezh_fast) \
363 SymX(decodeFloatzh_fast) \
366 SymX(deRefWeakzh_fast) \
367 SymX(deRefStablePtrzh_fast) \
368 SymX(divExactIntegerzh_fast) \
369 SymX(divModIntegerzh_fast) \
371 SymX(forkProcesszh_fast) \
372 SymX(freeHaskellFunctionPtr) \
373 SymX(freeStablePtr) \
374 SymX(gcdIntegerzh_fast) \
375 SymX(gcdIntegerIntzh_fast) \
376 SymX(gcdIntzh_fast) \
379 SymX(int2Integerzh_fast) \
380 SymX(integer2Intzh_fast) \
381 SymX(integer2Wordzh_fast) \
382 SymX(isDoubleDenormalized) \
383 SymX(isDoubleInfinite) \
385 SymX(isDoubleNegativeZero) \
386 SymX(isEmptyMVarzh_fast) \
387 SymX(isFloatDenormalized) \
388 SymX(isFloatInfinite) \
390 SymX(isFloatNegativeZero) \
391 SymX(killThreadzh_fast) \
392 SymX(makeStablePtrzh_fast) \
393 SymX(minusIntegerzh_fast) \
394 SymX(mkApUpd0zh_fast) \
395 SymX(myThreadIdzh_fast) \
396 SymX(labelThreadzh_fast) \
397 SymX(newArrayzh_fast) \
398 SymX(newBCOzh_fast) \
399 SymX(newByteArrayzh_fast) \
400 SymX_redirect(newCAF, newDynCAF) \
401 SymX(newMVarzh_fast) \
402 SymX(newMutVarzh_fast) \
403 SymX(atomicModifyMutVarzh_fast) \
404 SymX(newPinnedByteArrayzh_fast) \
405 SymX(orIntegerzh_fast) \
407 SymX(plusIntegerzh_fast) \
410 SymX(putMVarzh_fast) \
411 SymX(quotIntegerzh_fast) \
412 SymX(quotRemIntegerzh_fast) \
414 SymX(remIntegerzh_fast) \
415 SymX(resetNonBlockingFd) \
418 SymX(rts_checkSchedStatus) \
421 SymX(rts_evalLazyIO) \
425 SymX(rts_getDouble) \
430 SymX(rts_getFunPtr) \
431 SymX(rts_getStablePtr) \
432 SymX(rts_getThreadId) \
434 SymX(rts_getWord32) \
447 SymX(rts_mkStablePtr) \
457 SymX(startupHaskell) \
458 SymX(shutdownHaskell) \
459 SymX(shutdownHaskellAndExit) \
460 SymX(stable_ptr_table) \
461 SymX(stackOverflow) \
462 SymX(stg_CAF_BLACKHOLE_info) \
463 SymX(stg_CHARLIKE_closure) \
464 SymX(stg_EMPTY_MVAR_info) \
465 SymX(stg_IND_STATIC_info) \
466 SymX(stg_INTLIKE_closure) \
467 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
468 SymX(stg_WEAK_info) \
469 SymX(stg_ap_v_info) \
470 SymX(stg_ap_f_info) \
471 SymX(stg_ap_d_info) \
472 SymX(stg_ap_l_info) \
473 SymX(stg_ap_n_info) \
474 SymX(stg_ap_p_info) \
475 SymX(stg_ap_pv_info) \
476 SymX(stg_ap_pp_info) \
477 SymX(stg_ap_ppv_info) \
478 SymX(stg_ap_ppp_info) \
479 SymX(stg_ap_pppp_info) \
480 SymX(stg_ap_ppppp_info) \
481 SymX(stg_ap_pppppp_info) \
482 SymX(stg_ap_ppppppp_info) \
490 SymX(stg_ap_pv_ret) \
491 SymX(stg_ap_pp_ret) \
492 SymX(stg_ap_ppv_ret) \
493 SymX(stg_ap_ppp_ret) \
494 SymX(stg_ap_pppp_ret) \
495 SymX(stg_ap_ppppp_ret) \
496 SymX(stg_ap_pppppp_ret) \
497 SymX(stg_ap_ppppppp_ret) \
498 SymX(stg_ap_1_upd_info) \
499 SymX(stg_ap_2_upd_info) \
500 SymX(stg_ap_3_upd_info) \
501 SymX(stg_ap_4_upd_info) \
502 SymX(stg_ap_5_upd_info) \
503 SymX(stg_ap_6_upd_info) \
504 SymX(stg_ap_7_upd_info) \
505 SymX(stg_ap_8_upd_info) \
507 SymX(stg_sel_0_upd_info) \
508 SymX(stg_sel_10_upd_info) \
509 SymX(stg_sel_11_upd_info) \
510 SymX(stg_sel_12_upd_info) \
511 SymX(stg_sel_13_upd_info) \
512 SymX(stg_sel_14_upd_info) \
513 SymX(stg_sel_15_upd_info) \
514 SymX(stg_sel_1_upd_info) \
515 SymX(stg_sel_2_upd_info) \
516 SymX(stg_sel_3_upd_info) \
517 SymX(stg_sel_4_upd_info) \
518 SymX(stg_sel_5_upd_info) \
519 SymX(stg_sel_6_upd_info) \
520 SymX(stg_sel_7_upd_info) \
521 SymX(stg_sel_8_upd_info) \
522 SymX(stg_sel_9_upd_info) \
523 SymX(stg_upd_frame_info) \
524 SymX(suspendThread) \
525 SymX(takeMVarzh_fast) \
526 SymX(timesIntegerzh_fast) \
527 SymX(tryPutMVarzh_fast) \
528 SymX(tryTakeMVarzh_fast) \
529 SymX(unblockAsyncExceptionszh_fast) \
530 SymX(unsafeThawArrayzh_fast) \
531 SymX(waitReadzh_fast) \
532 SymX(waitWritezh_fast) \
533 SymX(word2Integerzh_fast) \
534 SymX(xorIntegerzh_fast) \
537 #ifdef SUPPORT_LONG_LONGS
538 #define RTS_LONG_LONG_SYMS \
539 SymX(int64ToIntegerzh_fast) \
540 SymX(word64ToIntegerzh_fast)
542 #define RTS_LONG_LONG_SYMS /* nothing */
545 // 64-bit support functions in libgcc.a
546 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
547 #define RTS_LIBGCC_SYMBOLS \
556 #elif defined(ia64_TARGET_ARCH)
557 #define RTS_LIBGCC_SYMBOLS \
565 #define RTS_LIBGCC_SYMBOLS
568 #ifdef darwin_TARGET_OS
569 // Symbols that don't have a leading underscore
570 // on Mac OS X. They have to receive special treatment,
571 // see machoInitSymbolsWithoutUnderscore()
572 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
577 /* entirely bogus claims about types of these symbols */
578 #define Sym(vvv) extern void vvv();
579 #define SymX(vvv) /**/
580 #define SymX_redirect(vvv,xxx) /**/
583 RTS_POSIX_ONLY_SYMBOLS
584 RTS_MINGW_ONLY_SYMBOLS
585 RTS_CYGWIN_ONLY_SYMBOLS
591 #ifdef LEADING_UNDERSCORE
592 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
594 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
597 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
599 #define SymX(vvv) Sym(vvv)
601 // SymX_redirect allows us to redirect references to one symbol to
602 // another symbol. See newCAF/newDynCAF for an example.
603 #define SymX_redirect(vvv,xxx) \
604 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
607 static RtsSymbolVal rtsSyms[] = {
610 RTS_POSIX_ONLY_SYMBOLS
611 RTS_MINGW_ONLY_SYMBOLS
612 RTS_CYGWIN_ONLY_SYMBOLS
614 { 0, 0 } /* sentinel */
617 /* -----------------------------------------------------------------------------
618 * Insert symbols into hash tables, checking for duplicates.
620 static void ghciInsertStrHashTable ( char* obj_name,
626 if (lookupHashTable(table, (StgWord)key) == NULL)
628 insertStrHashTable(table, (StgWord)key, data);
633 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
635 "whilst processing object file\n"
637 "This could be caused by:\n"
638 " * Loading two different object files which export the same symbol\n"
639 " * Specifying the same object file twice on the GHCi command line\n"
640 " * An incorrect `package.conf' entry, causing some object to be\n"
642 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
651 /* -----------------------------------------------------------------------------
652 * initialize the object linker
656 static int linker_init_done = 0 ;
658 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
659 static void *dl_prog_handle;
667 /* Make initLinker idempotent, so we can call it
668 before evey relevant operation; that means we
669 don't need to initialise the linker separately */
670 if (linker_init_done == 1) { return; } else {
671 linker_init_done = 1;
674 symhash = allocStrHashTable();
676 /* populate the symbol table with stuff from the RTS */
677 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
678 ghciInsertStrHashTable("(GHCi built-in symbols)",
679 symhash, sym->lbl, sym->addr);
681 # if defined(OBJFORMAT_MACHO)
682 machoInitSymbolsWithoutUnderscore();
685 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
686 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
690 /* -----------------------------------------------------------------------------
691 * Loading DLL or .so dynamic libraries
692 * -----------------------------------------------------------------------------
694 * Add a DLL from which symbols may be found. In the ELF case, just
695 * do RTLD_GLOBAL-style add, so no further messing around needs to
696 * happen in order that symbols in the loaded .so are findable --
697 * lookupSymbol() will subsequently see them by dlsym on the program's
698 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
700 * In the PEi386 case, open the DLLs and put handles to them in a
701 * linked list. When looking for a symbol, try all handles in the
702 * list. This means that we need to load even DLLs that are guaranteed
703 * to be in the ghc.exe image already, just so we can get a handle
704 * to give to loadSymbol, so that we can find the symbols. For such
705 * libraries, the LoadLibrary call should be a no-op except for returning
710 #if defined(OBJFORMAT_PEi386)
711 /* A record for storing handles into DLLs. */
716 struct _OpenedDLL* next;
721 /* A list thereof. */
722 static OpenedDLL* opened_dlls = NULL;
726 addDLL( char *dll_name )
728 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
729 /* ------------------- ELF DLL loader ------------------- */
735 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
737 /* dlopen failed; return a ptr to the error msg. */
739 if (errmsg == NULL) errmsg = "addDLL: unknown error";
746 # elif defined(OBJFORMAT_PEi386)
747 /* ------------------- Win32 DLL loader ------------------- */
755 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
757 /* See if we've already got it, and ignore if so. */
758 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
759 if (0 == strcmp(o_dll->name, dll_name))
763 /* The file name has no suffix (yet) so that we can try
764 both foo.dll and foo.drv
766 The documentation for LoadLibrary says:
767 If no file name extension is specified in the lpFileName
768 parameter, the default library extension .dll is
769 appended. However, the file name string can include a trailing
770 point character (.) to indicate that the module name has no
773 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
774 sprintf(buf, "%s.DLL", dll_name);
775 instance = LoadLibrary(buf);
776 if (instance == NULL) {
777 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
778 instance = LoadLibrary(buf);
779 if (instance == NULL) {
782 /* LoadLibrary failed; return a ptr to the error msg. */
783 return "addDLL: unknown error";
788 /* Add this DLL to the list of DLLs in which to search for symbols. */
789 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
790 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
791 strcpy(o_dll->name, dll_name);
792 o_dll->instance = instance;
793 o_dll->next = opened_dlls;
798 barf("addDLL: not implemented on this platform");
802 /* -----------------------------------------------------------------------------
803 * lookup a symbol in the hash table
806 lookupSymbol( char *lbl )
810 ASSERT(symhash != NULL);
811 val = lookupStrHashTable(symhash, lbl);
814 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
815 return dlsym(dl_prog_handle, lbl);
816 # elif defined(OBJFORMAT_PEi386)
819 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
820 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
822 /* HACK: if the name has an initial underscore, try stripping
823 it off & look that up first. I've yet to verify whether there's
824 a Rule that governs whether an initial '_' *should always* be
825 stripped off when mapping from import lib name to the DLL name.
827 sym = GetProcAddress(o_dll->instance, (lbl+1));
829 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
833 sym = GetProcAddress(o_dll->instance, lbl);
835 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
850 __attribute((unused))
852 lookupLocalSymbol( ObjectCode* oc, char *lbl )
856 val = lookupStrHashTable(oc->lochash, lbl);
866 /* -----------------------------------------------------------------------------
867 * Debugging aid: look in GHCi's object symbol tables for symbols
868 * within DELTA bytes of the specified address, and show their names.
871 void ghci_enquire ( char* addr );
873 void ghci_enquire ( char* addr )
878 const int DELTA = 64;
883 for (oc = objects; oc; oc = oc->next) {
884 for (i = 0; i < oc->n_symbols; i++) {
885 sym = oc->symbols[i];
886 if (sym == NULL) continue;
887 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
889 if (oc->lochash != NULL) {
890 a = lookupStrHashTable(oc->lochash, sym);
893 a = lookupStrHashTable(symhash, sym);
896 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
898 else if (addr-DELTA <= a && a <= addr+DELTA) {
899 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
906 #ifdef ia64_TARGET_ARCH
907 static unsigned int PLTSize(void);
910 /* -----------------------------------------------------------------------------
911 * Load an obj (populate the global symbol table, but don't resolve yet)
913 * Returns: 1 if ok, 0 on error.
916 loadObj( char *path )
930 /* fprintf(stderr, "loadObj %s\n", path ); */
932 /* Check that we haven't already loaded this object. Don't give up
933 at this stage; ocGetNames_* will barf later. */
937 for (o = objects; o; o = o->next) {
938 if (0 == strcmp(o->fileName, path))
944 "GHCi runtime linker: warning: looks like you're trying to load the\n"
945 "same object file twice:\n"
947 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
953 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
955 # if defined(OBJFORMAT_ELF)
956 oc->formatName = "ELF";
957 # elif defined(OBJFORMAT_PEi386)
958 oc->formatName = "PEi386";
959 # elif defined(OBJFORMAT_MACHO)
960 oc->formatName = "Mach-O";
963 barf("loadObj: not implemented on this platform");
967 if (r == -1) { return 0; }
969 /* sigh, strdup() isn't a POSIX function, so do it the long way */
970 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
971 strcpy(oc->fileName, path);
973 oc->fileSize = st.st_size;
976 oc->lochash = allocStrHashTable();
977 oc->proddables = NULL;
979 /* chain it onto the list of objects */
984 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
986 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
988 fd = open(path, O_RDONLY);
990 barf("loadObj: can't open `%s'", path);
992 pagesize = getpagesize();
994 #ifdef ia64_TARGET_ARCH
995 /* The PLT needs to be right before the object */
996 n = ROUND_UP(PLTSize(), pagesize);
997 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
998 if (oc->plt == MAP_FAILED)
999 barf("loadObj: can't allocate PLT");
1002 map_addr = oc->plt + n;
1005 n = ROUND_UP(oc->fileSize, pagesize);
1006 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1007 if (oc->image == MAP_FAILED)
1008 barf("loadObj: can't map `%s'", path);
1012 #else /* !USE_MMAP */
1014 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1016 /* load the image into memory */
1017 f = fopen(path, "rb");
1019 barf("loadObj: can't read `%s'", path);
1021 n = fread ( oc->image, 1, oc->fileSize, f );
1022 if (n != oc->fileSize)
1023 barf("loadObj: error whilst reading `%s'", path);
1027 #endif /* USE_MMAP */
1029 /* verify the in-memory image */
1030 # if defined(OBJFORMAT_ELF)
1031 r = ocVerifyImage_ELF ( oc );
1032 # elif defined(OBJFORMAT_PEi386)
1033 r = ocVerifyImage_PEi386 ( oc );
1034 # elif defined(OBJFORMAT_MACHO)
1035 r = ocVerifyImage_MachO ( oc );
1037 barf("loadObj: no verify method");
1039 if (!r) { return r; }
1041 /* build the symbol list for this image */
1042 # if defined(OBJFORMAT_ELF)
1043 r = ocGetNames_ELF ( oc );
1044 # elif defined(OBJFORMAT_PEi386)
1045 r = ocGetNames_PEi386 ( oc );
1046 # elif defined(OBJFORMAT_MACHO)
1047 r = ocGetNames_MachO ( oc );
1049 barf("loadObj: no getNames method");
1051 if (!r) { return r; }
1053 /* loaded, but not resolved yet */
1054 oc->status = OBJECT_LOADED;
1059 /* -----------------------------------------------------------------------------
1060 * resolve all the currently unlinked objects in memory
1062 * Returns: 1 if ok, 0 on error.
1072 for (oc = objects; oc; oc = oc->next) {
1073 if (oc->status != OBJECT_RESOLVED) {
1074 # if defined(OBJFORMAT_ELF)
1075 r = ocResolve_ELF ( oc );
1076 # elif defined(OBJFORMAT_PEi386)
1077 r = ocResolve_PEi386 ( oc );
1078 # elif defined(OBJFORMAT_MACHO)
1079 r = ocResolve_MachO ( oc );
1081 barf("resolveObjs: not implemented on this platform");
1083 if (!r) { return r; }
1084 oc->status = OBJECT_RESOLVED;
1090 /* -----------------------------------------------------------------------------
1091 * delete an object from the pool
1094 unloadObj( char *path )
1096 ObjectCode *oc, *prev;
1098 ASSERT(symhash != NULL);
1099 ASSERT(objects != NULL);
1104 for (oc = objects; oc; prev = oc, oc = oc->next) {
1105 if (!strcmp(oc->fileName,path)) {
1107 /* Remove all the mappings for the symbols within this
1112 for (i = 0; i < oc->n_symbols; i++) {
1113 if (oc->symbols[i] != NULL) {
1114 removeStrHashTable(symhash, oc->symbols[i], NULL);
1122 prev->next = oc->next;
1125 /* We're going to leave this in place, in case there are
1126 any pointers from the heap into it: */
1127 /* stgFree(oc->image); */
1128 stgFree(oc->fileName);
1129 stgFree(oc->symbols);
1130 stgFree(oc->sections);
1131 /* The local hash table should have been freed at the end
1132 of the ocResolve_ call on it. */
1133 ASSERT(oc->lochash == NULL);
1139 belch("unloadObj: can't find `%s' to unload", path);
1143 /* -----------------------------------------------------------------------------
1144 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1145 * which may be prodded during relocation, and abort if we try and write
1146 * outside any of these.
1148 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1151 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1152 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1156 pb->next = oc->proddables;
1157 oc->proddables = pb;
1160 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1163 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1164 char* s = (char*)(pb->start);
1165 char* e = s + pb->size - 1;
1166 char* a = (char*)addr;
1167 /* Assumes that the biggest fixup involves a 4-byte write. This
1168 probably needs to be changed to 8 (ie, +7) on 64-bit
1170 if (a >= s && (a+3) <= e) return;
1172 barf("checkProddableBlock: invalid fixup in runtime linker");
1175 /* -----------------------------------------------------------------------------
1176 * Section management.
1178 static void addSection ( ObjectCode* oc, SectionKind kind,
1179 void* start, void* end )
1181 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1185 s->next = oc->sections;
1188 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1189 start, ((char*)end)-1, end - start + 1, kind );
1195 /* --------------------------------------------------------------------------
1196 * PEi386 specifics (Win32 targets)
1197 * ------------------------------------------------------------------------*/
1199 /* The information for this linker comes from
1200 Microsoft Portable Executable
1201 and Common Object File Format Specification
1202 revision 5.1 January 1998
1203 which SimonM says comes from the MS Developer Network CDs.
1205 It can be found there (on older CDs), but can also be found
1208 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1210 (this is Rev 6.0 from February 1999).
1212 Things move, so if that fails, try searching for it via
1214 http://www.google.com/search?q=PE+COFF+specification
1216 The ultimate reference for the PE format is the Winnt.h
1217 header file that comes with the Platform SDKs; as always,
1218 implementations will drift wrt their documentation.
1220 A good background article on the PE format is Matt Pietrek's
1221 March 1994 article in Microsoft System Journal (MSJ)
1222 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1223 Win32 Portable Executable File Format." The info in there
1224 has recently been updated in a two part article in
1225 MSDN magazine, issues Feb and March 2002,
1226 "Inside Windows: An In-Depth Look into the Win32 Portable
1227 Executable File Format"
1229 John Levine's book "Linkers and Loaders" contains useful
1234 #if defined(OBJFORMAT_PEi386)
1238 typedef unsigned char UChar;
1239 typedef unsigned short UInt16;
1240 typedef unsigned int UInt32;
1247 UInt16 NumberOfSections;
1248 UInt32 TimeDateStamp;
1249 UInt32 PointerToSymbolTable;
1250 UInt32 NumberOfSymbols;
1251 UInt16 SizeOfOptionalHeader;
1252 UInt16 Characteristics;
1256 #define sizeof_COFF_header 20
1263 UInt32 VirtualAddress;
1264 UInt32 SizeOfRawData;
1265 UInt32 PointerToRawData;
1266 UInt32 PointerToRelocations;
1267 UInt32 PointerToLinenumbers;
1268 UInt16 NumberOfRelocations;
1269 UInt16 NumberOfLineNumbers;
1270 UInt32 Characteristics;
1274 #define sizeof_COFF_section 40
1281 UInt16 SectionNumber;
1284 UChar NumberOfAuxSymbols;
1288 #define sizeof_COFF_symbol 18
1293 UInt32 VirtualAddress;
1294 UInt32 SymbolTableIndex;
1299 #define sizeof_COFF_reloc 10
1302 /* From PE spec doc, section 3.3.2 */
1303 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1304 windows.h -- for the same purpose, but I want to know what I'm
1306 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1307 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1308 #define MYIMAGE_FILE_DLL 0x2000
1309 #define MYIMAGE_FILE_SYSTEM 0x1000
1310 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1311 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1312 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1314 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1315 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1316 #define MYIMAGE_SYM_CLASS_STATIC 3
1317 #define MYIMAGE_SYM_UNDEFINED 0
1319 /* From PE spec doc, section 4.1 */
1320 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1321 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1322 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1324 /* From PE spec doc, section 5.2.1 */
1325 #define MYIMAGE_REL_I386_DIR32 0x0006
1326 #define MYIMAGE_REL_I386_REL32 0x0014
1329 /* We use myindex to calculate array addresses, rather than
1330 simply doing the normal subscript thing. That's because
1331 some of the above structs have sizes which are not
1332 a whole number of words. GCC rounds their sizes up to a
1333 whole number of words, which means that the address calcs
1334 arising from using normal C indexing or pointer arithmetic
1335 are just plain wrong. Sigh.
1338 myindex ( int scale, void* base, int index )
1341 ((UChar*)base) + scale * index;
1346 printName ( UChar* name, UChar* strtab )
1348 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1349 UInt32 strtab_offset = * (UInt32*)(name+4);
1350 fprintf ( stderr, "%s", strtab + strtab_offset );
1353 for (i = 0; i < 8; i++) {
1354 if (name[i] == 0) break;
1355 fprintf ( stderr, "%c", name[i] );
1362 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1364 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1365 UInt32 strtab_offset = * (UInt32*)(name+4);
1366 strncpy ( dst, strtab+strtab_offset, dstSize );
1372 if (name[i] == 0) break;
1382 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1385 /* If the string is longer than 8 bytes, look in the
1386 string table for it -- this will be correctly zero terminated.
1388 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1389 UInt32 strtab_offset = * (UInt32*)(name+4);
1390 return ((UChar*)strtab) + strtab_offset;
1392 /* Otherwise, if shorter than 8 bytes, return the original,
1393 which by defn is correctly terminated.
1395 if (name[7]==0) return name;
1396 /* The annoying case: 8 bytes. Copy into a temporary
1397 (which is never freed ...)
1399 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1401 strncpy(newstr,name,8);
1407 /* Just compares the short names (first 8 chars) */
1408 static COFF_section *
1409 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1413 = (COFF_header*)(oc->image);
1414 COFF_section* sectab
1416 ((UChar*)(oc->image))
1417 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1419 for (i = 0; i < hdr->NumberOfSections; i++) {
1422 COFF_section* section_i
1424 myindex ( sizeof_COFF_section, sectab, i );
1425 n1 = (UChar*) &(section_i->Name);
1427 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1428 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1429 n1[6]==n2[6] && n1[7]==n2[7])
1438 zapTrailingAtSign ( UChar* sym )
1440 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1442 if (sym[0] == 0) return;
1444 while (sym[i] != 0) i++;
1447 while (j > 0 && my_isdigit(sym[j])) j--;
1448 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1454 ocVerifyImage_PEi386 ( ObjectCode* oc )
1459 COFF_section* sectab;
1460 COFF_symbol* symtab;
1462 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1463 hdr = (COFF_header*)(oc->image);
1464 sectab = (COFF_section*) (
1465 ((UChar*)(oc->image))
1466 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1468 symtab = (COFF_symbol*) (
1469 ((UChar*)(oc->image))
1470 + hdr->PointerToSymbolTable
1472 strtab = ((UChar*)symtab)
1473 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1475 if (hdr->Machine != 0x14c) {
1476 belch("Not x86 PEi386");
1479 if (hdr->SizeOfOptionalHeader != 0) {
1480 belch("PEi386 with nonempty optional header");
1483 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1484 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1485 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1486 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1487 belch("Not a PEi386 object file");
1490 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1491 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1492 belch("Invalid PEi386 word size or endiannness: %d",
1493 (int)(hdr->Characteristics));
1496 /* If the string table size is way crazy, this might indicate that
1497 there are more than 64k relocations, despite claims to the
1498 contrary. Hence this test. */
1499 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1501 if ( (*(UInt32*)strtab) > 600000 ) {
1502 /* Note that 600k has no special significance other than being
1503 big enough to handle the almost-2MB-sized lumps that
1504 constitute HSwin32*.o. */
1505 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1510 /* No further verification after this point; only debug printing. */
1512 IF_DEBUG(linker, i=1);
1513 if (i == 0) return 1;
1516 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1518 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1520 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1522 fprintf ( stderr, "\n" );
1524 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1526 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1528 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1530 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1532 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1534 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1536 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1538 /* Print the section table. */
1539 fprintf ( stderr, "\n" );
1540 for (i = 0; i < hdr->NumberOfSections; i++) {
1542 COFF_section* sectab_i
1544 myindex ( sizeof_COFF_section, sectab, i );
1551 printName ( sectab_i->Name, strtab );
1561 sectab_i->VirtualSize,
1562 sectab_i->VirtualAddress,
1563 sectab_i->SizeOfRawData,
1564 sectab_i->PointerToRawData,
1565 sectab_i->NumberOfRelocations,
1566 sectab_i->PointerToRelocations,
1567 sectab_i->PointerToRawData
1569 reltab = (COFF_reloc*) (
1570 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1573 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1574 /* If the relocation field (a short) has overflowed, the
1575 * real count can be found in the first reloc entry.
1577 * See Section 4.1 (last para) of the PE spec (rev6.0).
1579 COFF_reloc* rel = (COFF_reloc*)
1580 myindex ( sizeof_COFF_reloc, reltab, 0 );
1581 noRelocs = rel->VirtualAddress;
1584 noRelocs = sectab_i->NumberOfRelocations;
1588 for (; j < noRelocs; j++) {
1590 COFF_reloc* rel = (COFF_reloc*)
1591 myindex ( sizeof_COFF_reloc, reltab, j );
1593 " type 0x%-4x vaddr 0x%-8x name `",
1595 rel->VirtualAddress );
1596 sym = (COFF_symbol*)
1597 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1598 /* Hmm..mysterious looking offset - what's it for? SOF */
1599 printName ( sym->Name, strtab -10 );
1600 fprintf ( stderr, "'\n" );
1603 fprintf ( stderr, "\n" );
1605 fprintf ( stderr, "\n" );
1606 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1607 fprintf ( stderr, "---START of string table---\n");
1608 for (i = 4; i < *(Int32*)strtab; i++) {
1610 fprintf ( stderr, "\n"); else
1611 fprintf( stderr, "%c", strtab[i] );
1613 fprintf ( stderr, "--- END of string table---\n");
1615 fprintf ( stderr, "\n" );
1618 COFF_symbol* symtab_i;
1619 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1620 symtab_i = (COFF_symbol*)
1621 myindex ( sizeof_COFF_symbol, symtab, i );
1627 printName ( symtab_i->Name, strtab );
1636 (Int32)(symtab_i->SectionNumber),
1637 (UInt32)symtab_i->Type,
1638 (UInt32)symtab_i->StorageClass,
1639 (UInt32)symtab_i->NumberOfAuxSymbols
1641 i += symtab_i->NumberOfAuxSymbols;
1645 fprintf ( stderr, "\n" );
1651 ocGetNames_PEi386 ( ObjectCode* oc )
1654 COFF_section* sectab;
1655 COFF_symbol* symtab;
1662 hdr = (COFF_header*)(oc->image);
1663 sectab = (COFF_section*) (
1664 ((UChar*)(oc->image))
1665 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1667 symtab = (COFF_symbol*) (
1668 ((UChar*)(oc->image))
1669 + hdr->PointerToSymbolTable
1671 strtab = ((UChar*)(oc->image))
1672 + hdr->PointerToSymbolTable
1673 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1675 /* Allocate space for any (local, anonymous) .bss sections. */
1677 for (i = 0; i < hdr->NumberOfSections; i++) {
1679 COFF_section* sectab_i
1681 myindex ( sizeof_COFF_section, sectab, i );
1682 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1683 if (sectab_i->VirtualSize == 0) continue;
1684 /* This is a non-empty .bss section. Allocate zeroed space for
1685 it, and set its PointerToRawData field such that oc->image +
1686 PointerToRawData == addr_of_zeroed_space. */
1687 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1688 "ocGetNames_PEi386(anonymous bss)");
1689 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1690 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1691 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1694 /* Copy section information into the ObjectCode. */
1696 for (i = 0; i < hdr->NumberOfSections; i++) {
1702 = SECTIONKIND_OTHER;
1703 COFF_section* sectab_i
1705 myindex ( sizeof_COFF_section, sectab, i );
1706 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1709 /* I'm sure this is the Right Way to do it. However, the
1710 alternative of testing the sectab_i->Name field seems to
1711 work ok with Cygwin.
1713 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1714 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1715 kind = SECTIONKIND_CODE_OR_RODATA;
1718 if (0==strcmp(".text",sectab_i->Name) ||
1719 0==strcmp(".rodata",sectab_i->Name))
1720 kind = SECTIONKIND_CODE_OR_RODATA;
1721 if (0==strcmp(".data",sectab_i->Name) ||
1722 0==strcmp(".bss",sectab_i->Name))
1723 kind = SECTIONKIND_RWDATA;
1725 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1726 sz = sectab_i->SizeOfRawData;
1727 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1729 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1730 end = start + sz - 1;
1732 if (kind == SECTIONKIND_OTHER
1733 /* Ignore sections called which contain stabs debugging
1735 && 0 != strcmp(".stab", sectab_i->Name)
1736 && 0 != strcmp(".stabstr", sectab_i->Name)
1738 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1742 if (kind != SECTIONKIND_OTHER && end >= start) {
1743 addSection(oc, kind, start, end);
1744 addProddableBlock(oc, start, end - start + 1);
1748 /* Copy exported symbols into the ObjectCode. */
1750 oc->n_symbols = hdr->NumberOfSymbols;
1751 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1752 "ocGetNames_PEi386(oc->symbols)");
1753 /* Call me paranoid; I don't care. */
1754 for (i = 0; i < oc->n_symbols; i++)
1755 oc->symbols[i] = NULL;
1759 COFF_symbol* symtab_i;
1760 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1761 symtab_i = (COFF_symbol*)
1762 myindex ( sizeof_COFF_symbol, symtab, i );
1766 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1767 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1768 /* This symbol is global and defined, viz, exported */
1769 /* for MYIMAGE_SYMCLASS_EXTERNAL
1770 && !MYIMAGE_SYM_UNDEFINED,
1771 the address of the symbol is:
1772 address of relevant section + offset in section
1774 COFF_section* sectabent
1775 = (COFF_section*) myindex ( sizeof_COFF_section,
1777 symtab_i->SectionNumber-1 );
1778 addr = ((UChar*)(oc->image))
1779 + (sectabent->PointerToRawData
1783 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1784 && symtab_i->Value > 0) {
1785 /* This symbol isn't in any section at all, ie, global bss.
1786 Allocate zeroed space for it. */
1787 addr = stgCallocBytes(1, symtab_i->Value,
1788 "ocGetNames_PEi386(non-anonymous bss)");
1789 addSection(oc, SECTIONKIND_RWDATA, addr,
1790 ((UChar*)addr) + symtab_i->Value - 1);
1791 addProddableBlock(oc, addr, symtab_i->Value);
1792 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1795 if (addr != NULL ) {
1796 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1797 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1798 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1799 ASSERT(i >= 0 && i < oc->n_symbols);
1800 /* cstring_from_COFF_symbol_name always succeeds. */
1801 oc->symbols[i] = sname;
1802 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1806 "IGNORING symbol %d\n"
1810 printName ( symtab_i->Name, strtab );
1819 (Int32)(symtab_i->SectionNumber),
1820 (UInt32)symtab_i->Type,
1821 (UInt32)symtab_i->StorageClass,
1822 (UInt32)symtab_i->NumberOfAuxSymbols
1827 i += symtab_i->NumberOfAuxSymbols;
1836 ocResolve_PEi386 ( ObjectCode* oc )
1839 COFF_section* sectab;
1840 COFF_symbol* symtab;
1850 /* ToDo: should be variable-sized? But is at least safe in the
1851 sense of buffer-overrun-proof. */
1853 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1855 hdr = (COFF_header*)(oc->image);
1856 sectab = (COFF_section*) (
1857 ((UChar*)(oc->image))
1858 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1860 symtab = (COFF_symbol*) (
1861 ((UChar*)(oc->image))
1862 + hdr->PointerToSymbolTable
1864 strtab = ((UChar*)(oc->image))
1865 + hdr->PointerToSymbolTable
1866 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1868 for (i = 0; i < hdr->NumberOfSections; i++) {
1869 COFF_section* sectab_i
1871 myindex ( sizeof_COFF_section, sectab, i );
1874 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1877 /* Ignore sections called which contain stabs debugging
1879 if (0 == strcmp(".stab", sectab_i->Name)
1880 || 0 == strcmp(".stabstr", sectab_i->Name))
1883 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1884 /* If the relocation field (a short) has overflowed, the
1885 * real count can be found in the first reloc entry.
1887 * See Section 4.1 (last para) of the PE spec (rev6.0).
1889 COFF_reloc* rel = (COFF_reloc*)
1890 myindex ( sizeof_COFF_reloc, reltab, 0 );
1891 noRelocs = rel->VirtualAddress;
1892 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1895 noRelocs = sectab_i->NumberOfRelocations;
1900 for (; j < noRelocs; j++) {
1902 COFF_reloc* reltab_j
1904 myindex ( sizeof_COFF_reloc, reltab, j );
1906 /* the location to patch */
1908 ((UChar*)(oc->image))
1909 + (sectab_i->PointerToRawData
1910 + reltab_j->VirtualAddress
1911 - sectab_i->VirtualAddress )
1913 /* the existing contents of pP */
1915 /* the symbol to connect to */
1916 sym = (COFF_symbol*)
1917 myindex ( sizeof_COFF_symbol,
1918 symtab, reltab_j->SymbolTableIndex );
1921 "reloc sec %2d num %3d: type 0x%-4x "
1922 "vaddr 0x%-8x name `",
1924 (UInt32)reltab_j->Type,
1925 reltab_j->VirtualAddress );
1926 printName ( sym->Name, strtab );
1927 fprintf ( stderr, "'\n" ));
1929 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1930 COFF_section* section_sym
1931 = findPEi386SectionCalled ( oc, sym->Name );
1933 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1936 S = ((UInt32)(oc->image))
1937 + (section_sym->PointerToRawData
1940 copyName ( sym->Name, strtab, symbol, 1000-1 );
1941 (void*)S = lookupLocalSymbol( oc, symbol );
1942 if ((void*)S != NULL) goto foundit;
1943 (void*)S = lookupSymbol( symbol );
1944 if ((void*)S != NULL) goto foundit;
1945 zapTrailingAtSign ( symbol );
1946 (void*)S = lookupLocalSymbol( oc, symbol );
1947 if ((void*)S != NULL) goto foundit;
1948 (void*)S = lookupSymbol( symbol );
1949 if ((void*)S != NULL) goto foundit;
1950 /* Newline first because the interactive linker has printed "linking..." */
1951 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1955 checkProddableBlock(oc, pP);
1956 switch (reltab_j->Type) {
1957 case MYIMAGE_REL_I386_DIR32:
1960 case MYIMAGE_REL_I386_REL32:
1961 /* Tricky. We have to insert a displacement at
1962 pP which, when added to the PC for the _next_
1963 insn, gives the address of the target (S).
1964 Problem is to know the address of the next insn
1965 when we only know pP. We assume that this
1966 literal field is always the last in the insn,
1967 so that the address of the next insn is pP+4
1968 -- hence the constant 4.
1969 Also I don't know if A should be added, but so
1970 far it has always been zero.
1973 *pP = S - ((UInt32)pP) - 4;
1976 belch("%s: unhandled PEi386 relocation type %d",
1977 oc->fileName, reltab_j->Type);
1984 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1988 #endif /* defined(OBJFORMAT_PEi386) */
1991 /* --------------------------------------------------------------------------
1993 * ------------------------------------------------------------------------*/
1995 #if defined(OBJFORMAT_ELF)
2000 #if defined(sparc_TARGET_ARCH)
2001 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2002 #elif defined(i386_TARGET_ARCH)
2003 # define ELF_TARGET_386 /* Used inside <elf.h> */
2004 #elif defined (ia64_TARGET_ARCH)
2005 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2007 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2008 # define ELF_NEED_GOT /* needs Global Offset Table */
2009 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2015 * Define a set of types which can be used for both ELF32 and ELF64
2019 #define ELFCLASS ELFCLASS64
2020 #define Elf_Addr Elf64_Addr
2021 #define Elf_Word Elf64_Word
2022 #define Elf_Sword Elf64_Sword
2023 #define Elf_Ehdr Elf64_Ehdr
2024 #define Elf_Phdr Elf64_Phdr
2025 #define Elf_Shdr Elf64_Shdr
2026 #define Elf_Sym Elf64_Sym
2027 #define Elf_Rel Elf64_Rel
2028 #define Elf_Rela Elf64_Rela
2029 #define ELF_ST_TYPE ELF64_ST_TYPE
2030 #define ELF_ST_BIND ELF64_ST_BIND
2031 #define ELF_R_TYPE ELF64_R_TYPE
2032 #define ELF_R_SYM ELF64_R_SYM
2034 #define ELFCLASS ELFCLASS32
2035 #define Elf_Addr Elf32_Addr
2036 #define Elf_Word Elf32_Word
2037 #define Elf_Sword Elf32_Sword
2038 #define Elf_Ehdr Elf32_Ehdr
2039 #define Elf_Phdr Elf32_Phdr
2040 #define Elf_Shdr Elf32_Shdr
2041 #define Elf_Sym Elf32_Sym
2042 #define Elf_Rel Elf32_Rel
2043 #define Elf_Rela Elf32_Rela
2044 #define ELF_ST_TYPE ELF32_ST_TYPE
2045 #define ELF_ST_BIND ELF32_ST_BIND
2046 #define ELF_R_TYPE ELF32_R_TYPE
2047 #define ELF_R_SYM ELF32_R_SYM
2052 * Functions to allocate entries in dynamic sections. Currently we simply
2053 * preallocate a large number, and we don't check if a entry for the given
2054 * target already exists (a linear search is too slow). Ideally these
2055 * entries would be associated with symbols.
2058 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2059 #define GOT_SIZE 0x20000
2060 #define FUNCTION_TABLE_SIZE 0x10000
2061 #define PLT_SIZE 0x08000
2064 static Elf_Addr got[GOT_SIZE];
2065 static unsigned int gotIndex;
2066 static Elf_Addr gp_val = (Elf_Addr)got;
2069 allocateGOTEntry(Elf_Addr target)
2073 if (gotIndex >= GOT_SIZE)
2074 barf("Global offset table overflow");
2076 entry = &got[gotIndex++];
2078 return (Elf_Addr)entry;
2082 #ifdef ELF_FUNCTION_DESC
2088 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2089 static unsigned int functionTableIndex;
2092 allocateFunctionDesc(Elf_Addr target)
2094 FunctionDesc *entry;
2096 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2097 barf("Function table overflow");
2099 entry = &functionTable[functionTableIndex++];
2101 entry->gp = (Elf_Addr)gp_val;
2102 return (Elf_Addr)entry;
2106 copyFunctionDesc(Elf_Addr target)
2108 FunctionDesc *olddesc = (FunctionDesc *)target;
2109 FunctionDesc *newdesc;
2111 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2112 newdesc->gp = olddesc->gp;
2113 return (Elf_Addr)newdesc;
2118 #ifdef ia64_TARGET_ARCH
2119 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2120 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2122 static unsigned char plt_code[] =
2124 /* taken from binutils bfd/elfxx-ia64.c */
2125 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2126 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2127 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2128 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2129 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2130 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2133 /* If we can't get to the function descriptor via gp, take a local copy of it */
2134 #define PLT_RELOC(code, target) { \
2135 Elf64_Sxword rel_value = target - gp_val; \
2136 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2137 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2139 ia64_reloc_gprel22((Elf_Addr)code, target); \
2144 unsigned char code[sizeof(plt_code)];
2148 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2150 PLTEntry *plt = (PLTEntry *)oc->plt;
2153 if (oc->pltIndex >= PLT_SIZE)
2154 barf("Procedure table overflow");
2156 entry = &plt[oc->pltIndex++];
2157 memcpy(entry->code, plt_code, sizeof(entry->code));
2158 PLT_RELOC(entry->code, target);
2159 return (Elf_Addr)entry;
2165 return (PLT_SIZE * sizeof(PLTEntry));
2171 * Generic ELF functions
2175 findElfSection ( void* objImage, Elf_Word sh_type )
2177 char* ehdrC = (char*)objImage;
2178 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2179 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2180 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2184 for (i = 0; i < ehdr->e_shnum; i++) {
2185 if (shdr[i].sh_type == sh_type
2186 /* Ignore the section header's string table. */
2187 && i != ehdr->e_shstrndx
2188 /* Ignore string tables named .stabstr, as they contain
2190 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2192 ptr = ehdrC + shdr[i].sh_offset;
2199 #if defined(ia64_TARGET_ARCH)
2201 findElfSegment ( void* objImage, Elf_Addr vaddr )
2203 char* ehdrC = (char*)objImage;
2204 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2205 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2206 Elf_Addr segaddr = 0;
2209 for (i = 0; i < ehdr->e_phnum; i++) {
2210 segaddr = phdr[i].p_vaddr;
2211 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2219 ocVerifyImage_ELF ( ObjectCode* oc )
2223 int i, j, nent, nstrtab, nsymtabs;
2227 char* ehdrC = (char*)(oc->image);
2228 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2230 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2231 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2232 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2233 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2234 belch("%s: not an ELF object", oc->fileName);
2238 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2239 belch("%s: unsupported ELF format", oc->fileName);
2243 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2244 IF_DEBUG(linker,belch( "Is little-endian" ));
2246 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2247 IF_DEBUG(linker,belch( "Is big-endian" ));
2249 belch("%s: unknown endiannness", oc->fileName);
2253 if (ehdr->e_type != ET_REL) {
2254 belch("%s: not a relocatable object (.o) file", oc->fileName);
2257 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2259 IF_DEBUG(linker,belch( "Architecture is " ));
2260 switch (ehdr->e_machine) {
2261 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2262 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2264 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2266 default: IF_DEBUG(linker,belch( "unknown" ));
2267 belch("%s: unknown architecture", oc->fileName);
2271 IF_DEBUG(linker,belch(
2272 "\nSection header table: start %d, n_entries %d, ent_size %d",
2273 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2275 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2277 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2279 if (ehdr->e_shstrndx == SHN_UNDEF) {
2280 belch("%s: no section header string table", oc->fileName);
2283 IF_DEBUG(linker,belch( "Section header string table is section %d",
2285 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2288 for (i = 0; i < ehdr->e_shnum; i++) {
2289 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2290 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2291 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2292 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2293 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2294 ehdrC + shdr[i].sh_offset,
2295 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2297 if (shdr[i].sh_type == SHT_REL) {
2298 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2299 } else if (shdr[i].sh_type == SHT_RELA) {
2300 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2302 IF_DEBUG(linker,fprintf(stderr," "));
2305 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2309 IF_DEBUG(linker,belch( "\nString tables" ));
2312 for (i = 0; i < ehdr->e_shnum; i++) {
2313 if (shdr[i].sh_type == SHT_STRTAB
2314 /* Ignore the section header's string table. */
2315 && i != ehdr->e_shstrndx
2316 /* Ignore string tables named .stabstr, as they contain
2318 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2320 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2321 strtab = ehdrC + shdr[i].sh_offset;
2326 belch("%s: no string tables, or too many", oc->fileName);
2331 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2332 for (i = 0; i < ehdr->e_shnum; i++) {
2333 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2334 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2336 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2337 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2338 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2340 shdr[i].sh_size % sizeof(Elf_Sym)
2342 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2343 belch("%s: non-integral number of symbol table entries", oc->fileName);
2346 for (j = 0; j < nent; j++) {
2347 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2348 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2349 (int)stab[j].st_shndx,
2350 (int)stab[j].st_size,
2351 (char*)stab[j].st_value ));
2353 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2354 switch (ELF_ST_TYPE(stab[j].st_info)) {
2355 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2356 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2357 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2358 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2359 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2360 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2362 IF_DEBUG(linker,fprintf(stderr, " " ));
2364 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2365 switch (ELF_ST_BIND(stab[j].st_info)) {
2366 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2367 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2368 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2369 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2371 IF_DEBUG(linker,fprintf(stderr, " " ));
2373 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2377 if (nsymtabs == 0) {
2378 belch("%s: didn't find any symbol tables", oc->fileName);
2387 ocGetNames_ELF ( ObjectCode* oc )
2392 char* ehdrC = (char*)(oc->image);
2393 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2394 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2395 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2397 ASSERT(symhash != NULL);
2400 belch("%s: no strtab", oc->fileName);
2405 for (i = 0; i < ehdr->e_shnum; i++) {
2406 /* Figure out what kind of section it is. Logic derived from
2407 Figure 1.14 ("Special Sections") of the ELF document
2408 ("Portable Formats Specification, Version 1.1"). */
2409 Elf_Shdr hdr = shdr[i];
2410 SectionKind kind = SECTIONKIND_OTHER;
2413 if (hdr.sh_type == SHT_PROGBITS
2414 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2415 /* .text-style section */
2416 kind = SECTIONKIND_CODE_OR_RODATA;
2419 if (hdr.sh_type == SHT_PROGBITS
2420 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2421 /* .data-style section */
2422 kind = SECTIONKIND_RWDATA;
2425 if (hdr.sh_type == SHT_PROGBITS
2426 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2427 /* .rodata-style section */
2428 kind = SECTIONKIND_CODE_OR_RODATA;
2431 if (hdr.sh_type == SHT_NOBITS
2432 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2433 /* .bss-style section */
2434 kind = SECTIONKIND_RWDATA;
2438 if (is_bss && shdr[i].sh_size > 0) {
2439 /* This is a non-empty .bss section. Allocate zeroed space for
2440 it, and set its .sh_offset field such that
2441 ehdrC + .sh_offset == addr_of_zeroed_space. */
2442 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2443 "ocGetNames_ELF(BSS)");
2444 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2446 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2447 zspace, shdr[i].sh_size);
2451 /* fill in the section info */
2452 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2453 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2454 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2455 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2458 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2460 /* copy stuff into this module's object symbol table */
2461 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2462 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2464 oc->n_symbols = nent;
2465 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2466 "ocGetNames_ELF(oc->symbols)");
2468 for (j = 0; j < nent; j++) {
2470 char isLocal = FALSE; /* avoids uninit-var warning */
2472 char* nm = strtab + stab[j].st_name;
2473 int secno = stab[j].st_shndx;
2475 /* Figure out if we want to add it; if so, set ad to its
2476 address. Otherwise leave ad == NULL. */
2478 if (secno == SHN_COMMON) {
2480 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2482 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2483 stab[j].st_size, nm);
2485 /* Pointless to do addProddableBlock() for this area,
2486 since the linker should never poke around in it. */
2489 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2490 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2492 /* and not an undefined symbol */
2493 && stab[j].st_shndx != SHN_UNDEF
2494 /* and not in a "special section" */
2495 && stab[j].st_shndx < SHN_LORESERVE
2497 /* and it's a not a section or string table or anything silly */
2498 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2499 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2500 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2503 /* Section 0 is the undefined section, hence > and not >=. */
2504 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2506 if (shdr[secno].sh_type == SHT_NOBITS) {
2507 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2508 stab[j].st_size, stab[j].st_value, nm);
2511 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2512 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2515 #ifdef ELF_FUNCTION_DESC
2516 /* dlsym() and the initialisation table both give us function
2517 * descriptors, so to be consistent we store function descriptors
2518 * in the symbol table */
2519 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2520 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2522 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2523 ad, oc->fileName, nm ));
2528 /* And the decision is ... */
2532 oc->symbols[j] = nm;
2535 /* Ignore entirely. */
2537 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2541 IF_DEBUG(linker,belch( "skipping `%s'",
2542 strtab + stab[j].st_name ));
2545 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2546 (int)ELF_ST_BIND(stab[j].st_info),
2547 (int)ELF_ST_TYPE(stab[j].st_info),
2548 (int)stab[j].st_shndx,
2549 strtab + stab[j].st_name
2552 oc->symbols[j] = NULL;
2561 /* Do ELF relocations which lack an explicit addend. All x86-linux
2562 relocations appear to be of this form. */
2564 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2565 Elf_Shdr* shdr, int shnum,
2566 Elf_Sym* stab, char* strtab )
2571 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2572 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2573 int target_shndx = shdr[shnum].sh_info;
2574 int symtab_shndx = shdr[shnum].sh_link;
2576 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2577 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2578 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2579 target_shndx, symtab_shndx ));
2581 for (j = 0; j < nent; j++) {
2582 Elf_Addr offset = rtab[j].r_offset;
2583 Elf_Addr info = rtab[j].r_info;
2585 Elf_Addr P = ((Elf_Addr)targ) + offset;
2586 Elf_Word* pP = (Elf_Word*)P;
2591 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2592 j, (void*)offset, (void*)info ));
2594 IF_DEBUG(linker,belch( " ZERO" ));
2597 Elf_Sym sym = stab[ELF_R_SYM(info)];
2598 /* First see if it is a local symbol. */
2599 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2600 /* Yes, so we can get the address directly from the ELF symbol
2602 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2604 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2605 + stab[ELF_R_SYM(info)].st_value);
2608 /* No, so look up the name in our global table. */
2609 symbol = strtab + sym.st_name;
2610 (void*)S = lookupSymbol( symbol );
2613 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2616 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2619 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2620 (void*)P, (void*)S, (void*)A ));
2621 checkProddableBlock ( oc, pP );
2625 switch (ELF_R_TYPE(info)) {
2626 # ifdef i386_TARGET_ARCH
2627 case R_386_32: *pP = value; break;
2628 case R_386_PC32: *pP = value - P; break;
2631 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2632 oc->fileName, ELF_R_TYPE(info));
2640 /* Do ELF relocations for which explicit addends are supplied.
2641 sparc-solaris relocations appear to be of this form. */
2643 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2644 Elf_Shdr* shdr, int shnum,
2645 Elf_Sym* stab, char* strtab )
2650 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2651 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2652 int target_shndx = shdr[shnum].sh_info;
2653 int symtab_shndx = shdr[shnum].sh_link;
2655 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2656 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2657 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2658 target_shndx, symtab_shndx ));
2660 for (j = 0; j < nent; j++) {
2661 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2662 /* This #ifdef only serves to avoid unused-var warnings. */
2663 Elf_Addr offset = rtab[j].r_offset;
2664 Elf_Addr P = targ + offset;
2666 Elf_Addr info = rtab[j].r_info;
2667 Elf_Addr A = rtab[j].r_addend;
2670 # if defined(sparc_TARGET_ARCH)
2671 Elf_Word* pP = (Elf_Word*)P;
2673 # elif defined(ia64_TARGET_ARCH)
2674 Elf64_Xword *pP = (Elf64_Xword *)P;
2678 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2679 j, (void*)offset, (void*)info,
2682 IF_DEBUG(linker,belch( " ZERO" ));
2685 Elf_Sym sym = stab[ELF_R_SYM(info)];
2686 /* First see if it is a local symbol. */
2687 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2688 /* Yes, so we can get the address directly from the ELF symbol
2690 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2692 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2693 + stab[ELF_R_SYM(info)].st_value);
2694 #ifdef ELF_FUNCTION_DESC
2695 /* Make a function descriptor for this function */
2696 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2697 S = allocateFunctionDesc(S + A);
2702 /* No, so look up the name in our global table. */
2703 symbol = strtab + sym.st_name;
2704 (void*)S = lookupSymbol( symbol );
2706 #ifdef ELF_FUNCTION_DESC
2707 /* If a function, already a function descriptor - we would
2708 have to copy it to add an offset. */
2709 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2710 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2714 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2717 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2720 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2721 (void*)P, (void*)S, (void*)A ));
2722 /* checkProddableBlock ( oc, (void*)P ); */
2726 switch (ELF_R_TYPE(info)) {
2727 # if defined(sparc_TARGET_ARCH)
2728 case R_SPARC_WDISP30:
2729 w1 = *pP & 0xC0000000;
2730 w2 = (Elf_Word)((value - P) >> 2);
2731 ASSERT((w2 & 0xC0000000) == 0);
2736 w1 = *pP & 0xFFC00000;
2737 w2 = (Elf_Word)(value >> 10);
2738 ASSERT((w2 & 0xFFC00000) == 0);
2744 w2 = (Elf_Word)(value & 0x3FF);
2745 ASSERT((w2 & ~0x3FF) == 0);
2749 /* According to the Sun documentation:
2751 This relocation type resembles R_SPARC_32, except it refers to an
2752 unaligned word. That is, the word to be relocated must be treated
2753 as four separate bytes with arbitrary alignment, not as a word
2754 aligned according to the architecture requirements.
2756 (JRS: which means that freeloading on the R_SPARC_32 case
2757 is probably wrong, but hey ...)
2761 w2 = (Elf_Word)value;
2764 # elif defined(ia64_TARGET_ARCH)
2765 case R_IA64_DIR64LSB:
2766 case R_IA64_FPTR64LSB:
2769 case R_IA64_PCREL64LSB:
2772 case R_IA64_SEGREL64LSB:
2773 addr = findElfSegment(ehdrC, value);
2776 case R_IA64_GPREL22:
2777 ia64_reloc_gprel22(P, value);
2779 case R_IA64_LTOFF22:
2780 case R_IA64_LTOFF22X:
2781 case R_IA64_LTOFF_FPTR22:
2782 addr = allocateGOTEntry(value);
2783 ia64_reloc_gprel22(P, addr);
2785 case R_IA64_PCREL21B:
2786 ia64_reloc_pcrel21(P, S, oc);
2789 /* This goes with R_IA64_LTOFF22X and points to the load to
2790 * convert into a move. We don't implement relaxation. */
2794 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2795 oc->fileName, ELF_R_TYPE(info));
2804 ocResolve_ELF ( ObjectCode* oc )
2808 Elf_Sym* stab = NULL;
2809 char* ehdrC = (char*)(oc->image);
2810 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2811 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2812 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2814 /* first find "the" symbol table */
2815 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2817 /* also go find the string table */
2818 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2820 if (stab == NULL || strtab == NULL) {
2821 belch("%s: can't find string or symbol table", oc->fileName);
2825 /* Process the relocation sections. */
2826 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2828 /* Skip sections called ".rel.stab". These appear to contain
2829 relocation entries that, when done, make the stabs debugging
2830 info point at the right places. We ain't interested in all
2832 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2835 if (shdr[shnum].sh_type == SHT_REL ) {
2836 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2837 shnum, stab, strtab );
2841 if (shdr[shnum].sh_type == SHT_RELA) {
2842 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2843 shnum, stab, strtab );
2848 /* Free the local symbol table; we won't need it again. */
2849 freeHashTable(oc->lochash, NULL);
2857 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2858 * at the front. The following utility functions pack and unpack instructions, and
2859 * take care of the most common relocations.
2862 #ifdef ia64_TARGET_ARCH
2865 ia64_extract_instruction(Elf64_Xword *target)
2868 int slot = (Elf_Addr)target & 3;
2869 (Elf_Addr)target &= ~3;
2877 return ((w1 >> 5) & 0x1ffffffffff);
2879 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2883 barf("ia64_extract_instruction: invalid slot %p", target);
2888 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2890 int slot = (Elf_Addr)target & 3;
2891 (Elf_Addr)target &= ~3;
2896 *target |= value << 5;
2899 *target |= value << 46;
2900 *(target+1) |= value >> 18;
2903 *(target+1) |= value << 23;
2909 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2911 Elf64_Xword instruction;
2912 Elf64_Sxword rel_value;
2914 rel_value = value - gp_val;
2915 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2916 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2918 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2919 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2920 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2921 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2922 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2923 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2927 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2929 Elf64_Xword instruction;
2930 Elf64_Sxword rel_value;
2933 entry = allocatePLTEntry(value, oc);
2935 rel_value = (entry >> 4) - (target >> 4);
2936 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2937 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2939 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2940 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2941 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2942 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2949 /* --------------------------------------------------------------------------
2951 * ------------------------------------------------------------------------*/
2953 #if defined(OBJFORMAT_MACHO)
2956 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2957 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2959 I hereby formally apologize for the hackish nature of this code.
2960 Things that need to be done:
2961 *) get common symbols and .bss sections to work properly.
2962 Haskell modules seem to work, but C modules can cause problems
2963 *) implement ocVerifyImage_MachO
2964 *) add more sanity checks. The current code just has to segfault if there's a
2968 static int ocVerifyImage_MachO(ObjectCode* oc)
2970 // FIXME: do some verifying here
2974 static int resolveImports(
2977 struct symtab_command *symLC,
2978 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2979 unsigned long *indirectSyms,
2980 struct nlist *nlist)
2984 for(i=0;i*4<sect->size;i++)
2986 // according to otool, reserved1 contains the first index into the indirect symbol table
2987 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2988 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2991 if((symbol->n_type & N_TYPE) == N_UNDF
2992 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
2993 addr = (void*) (symbol->n_value);
2994 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
2997 addr = lookupSymbol(nm);
3000 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3004 ((void**)(image + sect->offset))[i] = addr;
3010 static int relocateSection(char *image,
3011 struct symtab_command *symLC, struct nlist *nlist,
3012 struct section* sections, struct section *sect)
3014 struct relocation_info *relocs;
3017 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3019 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3023 relocs = (struct relocation_info*) (image + sect->reloff);
3027 if(relocs[i].r_address & R_SCATTERED)
3029 struct scattered_relocation_info *scat =
3030 (struct scattered_relocation_info*) &relocs[i];
3034 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3036 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3038 *word = scat->r_value + sect->offset + ((long) image);
3042 continue; // FIXME: I hope it's OK to ignore all the others.
3046 struct relocation_info *reloc = &relocs[i];
3047 if(reloc->r_pcrel && !reloc->r_extern)
3050 if(reloc->r_length == 2)
3052 unsigned long word = 0;
3054 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3056 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3060 else if(reloc->r_type == PPC_RELOC_LO16)
3062 word = ((unsigned short*) wordPtr)[1];
3063 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3065 else if(reloc->r_type == PPC_RELOC_HI16)
3067 word = ((unsigned short*) wordPtr)[1] << 16;
3068 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3070 else if(reloc->r_type == PPC_RELOC_HA16)
3072 word = ((unsigned short*) wordPtr)[1] << 16;
3073 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3075 else if(reloc->r_type == PPC_RELOC_BR24)
3078 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3082 if(!reloc->r_extern)
3085 sections[reloc->r_symbolnum-1].offset
3086 - sections[reloc->r_symbolnum-1].addr
3093 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3094 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3095 word = (unsigned long) (lookupSymbol(nm));
3098 belch("\nunknown symbol `%s'", nm);
3103 word -= ((long)image) + sect->offset + reloc->r_address;
3106 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3111 else if(reloc->r_type == PPC_RELOC_LO16)
3113 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3116 else if(reloc->r_type == PPC_RELOC_HI16)
3118 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3121 else if(reloc->r_type == PPC_RELOC_HA16)
3123 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3124 + ((word & (1<<15)) ? 1 : 0);
3127 else if(reloc->r_type == PPC_RELOC_BR24)
3129 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3133 barf("\nunknown relocation %d",reloc->r_type);
3140 static int ocGetNames_MachO(ObjectCode* oc)
3142 char *image = (char*) oc->image;
3143 struct mach_header *header = (struct mach_header*) image;
3144 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3145 unsigned i,curSymbol;
3146 struct segment_command *segLC = NULL;
3147 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3148 struct symtab_command *symLC = NULL;
3149 struct dysymtab_command *dsymLC = NULL;
3150 struct nlist *nlist;
3151 unsigned long commonSize = 0;
3152 char *commonStorage = NULL;
3153 unsigned long commonCounter;
3155 for(i=0;i<header->ncmds;i++)
3157 if(lc->cmd == LC_SEGMENT)
3158 segLC = (struct segment_command*) lc;
3159 else if(lc->cmd == LC_SYMTAB)
3160 symLC = (struct symtab_command*) lc;
3161 else if(lc->cmd == LC_DYSYMTAB)
3162 dsymLC = (struct dysymtab_command*) lc;
3163 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3166 sections = (struct section*) (segLC+1);
3167 nlist = (struct nlist*) (image + symLC->symoff);
3169 for(i=0;i<segLC->nsects;i++)
3171 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3172 la_ptrs = §ions[i];
3173 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3174 nl_ptrs = §ions[i];
3176 // for now, only add __text and __const to the sections table
3177 else if(!strcmp(sections[i].sectname,"__text"))
3178 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3179 (void*) (image + sections[i].offset),
3180 (void*) (image + sections[i].offset + sections[i].size));
3181 else if(!strcmp(sections[i].sectname,"__const"))
3182 addSection(oc, SECTIONKIND_RWDATA,
3183 (void*) (image + sections[i].offset),
3184 (void*) (image + sections[i].offset + sections[i].size));
3185 else if(!strcmp(sections[i].sectname,"__data"))
3186 addSection(oc, SECTIONKIND_RWDATA,
3187 (void*) (image + sections[i].offset),
3188 (void*) (image + sections[i].offset + sections[i].size));
3191 // count external symbols defined here
3193 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3195 if((nlist[i].n_type & N_TYPE) == N_SECT)
3198 for(i=0;i<symLC->nsyms;i++)
3200 if((nlist[i].n_type & N_TYPE) == N_UNDF
3201 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3203 commonSize += nlist[i].n_value;
3207 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3208 "ocGetNames_MachO(oc->symbols)");
3210 // insert symbols into hash table
3211 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3213 if((nlist[i].n_type & N_TYPE) == N_SECT)
3215 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3216 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3217 sections[nlist[i].n_sect-1].offset
3218 - sections[nlist[i].n_sect-1].addr
3219 + nlist[i].n_value);
3220 oc->symbols[curSymbol++] = nm;
3224 // insert local symbols into lochash
3225 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3227 if((nlist[i].n_type & N_TYPE) == N_SECT)
3229 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3230 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3231 sections[nlist[i].n_sect-1].offset
3232 - sections[nlist[i].n_sect-1].addr
3233 + nlist[i].n_value);
3238 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3239 commonCounter = (unsigned long)commonStorage;
3240 for(i=0;i<symLC->nsyms;i++)
3242 if((nlist[i].n_type & N_TYPE) == N_UNDF
3243 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3245 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3246 unsigned long sz = nlist[i].n_value;
3248 nlist[i].n_value = commonCounter;
3250 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3251 oc->symbols[curSymbol++] = nm;
3253 commonCounter += sz;
3259 static int ocResolve_MachO(ObjectCode* oc)
3261 char *image = (char*) oc->image;
3262 struct mach_header *header = (struct mach_header*) image;
3263 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3265 struct segment_command *segLC = NULL;
3266 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3267 struct symtab_command *symLC = NULL;
3268 struct dysymtab_command *dsymLC = NULL;
3269 struct nlist *nlist;
3270 unsigned long *indirectSyms;
3272 for(i=0;i<header->ncmds;i++)
3274 if(lc->cmd == LC_SEGMENT)
3275 segLC = (struct segment_command*) lc;
3276 else if(lc->cmd == LC_SYMTAB)
3277 symLC = (struct symtab_command*) lc;
3278 else if(lc->cmd == LC_DYSYMTAB)
3279 dsymLC = (struct dysymtab_command*) lc;
3280 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3283 sections = (struct section*) (segLC+1);
3284 nlist = (struct nlist*) (image + symLC->symoff);
3286 for(i=0;i<segLC->nsects;i++)
3288 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3289 la_ptrs = §ions[i];
3290 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3291 nl_ptrs = §ions[i];
3294 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3297 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3300 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3303 for(i=0;i<segLC->nsects;i++)
3305 if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
3309 /* Free the local symbol table; we won't need it again. */
3310 freeHashTable(oc->lochash, NULL);
3316 * The Mach-O object format uses leading underscores. But not everywhere.
3317 * There is a small number of runtime support functions defined in
3318 * libcc_dynamic.a whose name does not have a leading underscore.
3319 * As a consequence, we can't get their address from C code.
3320 * We have to use inline assembler just to take the address of a function.
3324 static void machoInitSymbolsWithoutUnderscore()
3330 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3331 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3333 RTS_MACHO_NOUNDERLINE_SYMBOLS