1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.125 2003/07/20 21:28:04 panne 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(raiseIOzh_fast) \
415 SymX(remIntegerzh_fast) \
416 SymX(resetNonBlockingFd) \
419 SymX(rts_checkSchedStatus) \
422 SymX(rts_evalLazyIO) \
426 SymX(rts_getDouble) \
431 SymX(rts_getFunPtr) \
432 SymX(rts_getStablePtr) \
433 SymX(rts_getThreadId) \
435 SymX(rts_getWord32) \
448 SymX(rts_mkStablePtr) \
458 SymX(startupHaskell) \
459 SymX(shutdownHaskell) \
460 SymX(shutdownHaskellAndExit) \
461 SymX(stable_ptr_table) \
462 SymX(stackOverflow) \
463 SymX(stg_CAF_BLACKHOLE_info) \
464 SymX(stg_BLACKHOLE_BQ_info) \
465 SymX(awakenBlockedQueue) \
466 SymX(stg_CHARLIKE_closure) \
467 SymX(stg_EMPTY_MVAR_info) \
468 SymX(stg_IND_STATIC_info) \
469 SymX(stg_INTLIKE_closure) \
470 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
471 SymX(stg_WEAK_info) \
472 SymX(stg_ap_v_info) \
473 SymX(stg_ap_f_info) \
474 SymX(stg_ap_d_info) \
475 SymX(stg_ap_l_info) \
476 SymX(stg_ap_n_info) \
477 SymX(stg_ap_p_info) \
478 SymX(stg_ap_pv_info) \
479 SymX(stg_ap_pp_info) \
480 SymX(stg_ap_ppv_info) \
481 SymX(stg_ap_ppp_info) \
482 SymX(stg_ap_pppp_info) \
483 SymX(stg_ap_ppppp_info) \
484 SymX(stg_ap_pppppp_info) \
485 SymX(stg_ap_ppppppp_info) \
493 SymX(stg_ap_pv_ret) \
494 SymX(stg_ap_pp_ret) \
495 SymX(stg_ap_ppv_ret) \
496 SymX(stg_ap_ppp_ret) \
497 SymX(stg_ap_pppp_ret) \
498 SymX(stg_ap_ppppp_ret) \
499 SymX(stg_ap_pppppp_ret) \
500 SymX(stg_ap_ppppppp_ret) \
501 SymX(stg_ap_1_upd_info) \
502 SymX(stg_ap_2_upd_info) \
503 SymX(stg_ap_3_upd_info) \
504 SymX(stg_ap_4_upd_info) \
505 SymX(stg_ap_5_upd_info) \
506 SymX(stg_ap_6_upd_info) \
507 SymX(stg_ap_7_upd_info) \
508 SymX(stg_ap_8_upd_info) \
510 SymX(stg_sel_0_upd_info) \
511 SymX(stg_sel_10_upd_info) \
512 SymX(stg_sel_11_upd_info) \
513 SymX(stg_sel_12_upd_info) \
514 SymX(stg_sel_13_upd_info) \
515 SymX(stg_sel_14_upd_info) \
516 SymX(stg_sel_15_upd_info) \
517 SymX(stg_sel_1_upd_info) \
518 SymX(stg_sel_2_upd_info) \
519 SymX(stg_sel_3_upd_info) \
520 SymX(stg_sel_4_upd_info) \
521 SymX(stg_sel_5_upd_info) \
522 SymX(stg_sel_6_upd_info) \
523 SymX(stg_sel_7_upd_info) \
524 SymX(stg_sel_8_upd_info) \
525 SymX(stg_sel_9_upd_info) \
526 SymX(stg_upd_frame_info) \
527 SymX(suspendThread) \
528 SymX(takeMVarzh_fast) \
529 SymX(timesIntegerzh_fast) \
530 SymX(tryPutMVarzh_fast) \
531 SymX(tryTakeMVarzh_fast) \
532 SymX(unblockAsyncExceptionszh_fast) \
533 SymX(unsafeThawArrayzh_fast) \
534 SymX(waitReadzh_fast) \
535 SymX(waitWritezh_fast) \
536 SymX(word2Integerzh_fast) \
537 SymX(xorIntegerzh_fast) \
540 #ifdef SUPPORT_LONG_LONGS
541 #define RTS_LONG_LONG_SYMS \
542 SymX(int64ToIntegerzh_fast) \
543 SymX(word64ToIntegerzh_fast)
545 #define RTS_LONG_LONG_SYMS /* nothing */
548 // 64-bit support functions in libgcc.a
549 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
550 #define RTS_LIBGCC_SYMBOLS \
559 #elif defined(ia64_TARGET_ARCH)
560 #define RTS_LIBGCC_SYMBOLS \
568 #define RTS_LIBGCC_SYMBOLS
571 #ifdef darwin_TARGET_OS
572 // Symbols that don't have a leading underscore
573 // on Mac OS X. They have to receive special treatment,
574 // see machoInitSymbolsWithoutUnderscore()
575 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
580 /* entirely bogus claims about types of these symbols */
581 #define Sym(vvv) extern void vvv(void);
582 #define SymX(vvv) /**/
583 #define SymX_redirect(vvv,xxx) /**/
586 RTS_POSIX_ONLY_SYMBOLS
587 RTS_MINGW_ONLY_SYMBOLS
588 RTS_CYGWIN_ONLY_SYMBOLS
594 #ifdef LEADING_UNDERSCORE
595 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
597 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
600 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
602 #define SymX(vvv) Sym(vvv)
604 // SymX_redirect allows us to redirect references to one symbol to
605 // another symbol. See newCAF/newDynCAF for an example.
606 #define SymX_redirect(vvv,xxx) \
607 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
610 static RtsSymbolVal rtsSyms[] = {
613 RTS_POSIX_ONLY_SYMBOLS
614 RTS_MINGW_ONLY_SYMBOLS
615 RTS_CYGWIN_ONLY_SYMBOLS
617 { 0, 0 } /* sentinel */
620 /* -----------------------------------------------------------------------------
621 * Insert symbols into hash tables, checking for duplicates.
623 static void ghciInsertStrHashTable ( char* obj_name,
629 if (lookupHashTable(table, (StgWord)key) == NULL)
631 insertStrHashTable(table, (StgWord)key, data);
636 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
638 "whilst processing object file\n"
640 "This could be caused by:\n"
641 " * Loading two different object files which export the same symbol\n"
642 " * Specifying the same object file twice on the GHCi command line\n"
643 " * An incorrect `package.conf' entry, causing some object to be\n"
645 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
654 /* -----------------------------------------------------------------------------
655 * initialize the object linker
659 static int linker_init_done = 0 ;
661 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
662 static void *dl_prog_handle;
670 /* Make initLinker idempotent, so we can call it
671 before evey relevant operation; that means we
672 don't need to initialise the linker separately */
673 if (linker_init_done == 1) { return; } else {
674 linker_init_done = 1;
677 symhash = allocStrHashTable();
679 /* populate the symbol table with stuff from the RTS */
680 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
681 ghciInsertStrHashTable("(GHCi built-in symbols)",
682 symhash, sym->lbl, sym->addr);
684 # if defined(OBJFORMAT_MACHO)
685 machoInitSymbolsWithoutUnderscore();
688 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
689 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
693 /* -----------------------------------------------------------------------------
694 * Loading DLL or .so dynamic libraries
695 * -----------------------------------------------------------------------------
697 * Add a DLL from which symbols may be found. In the ELF case, just
698 * do RTLD_GLOBAL-style add, so no further messing around needs to
699 * happen in order that symbols in the loaded .so are findable --
700 * lookupSymbol() will subsequently see them by dlsym on the program's
701 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
703 * In the PEi386 case, open the DLLs and put handles to them in a
704 * linked list. When looking for a symbol, try all handles in the
705 * list. This means that we need to load even DLLs that are guaranteed
706 * to be in the ghc.exe image already, just so we can get a handle
707 * to give to loadSymbol, so that we can find the symbols. For such
708 * libraries, the LoadLibrary call should be a no-op except for returning
713 #if defined(OBJFORMAT_PEi386)
714 /* A record for storing handles into DLLs. */
719 struct _OpenedDLL* next;
724 /* A list thereof. */
725 static OpenedDLL* opened_dlls = NULL;
729 addDLL( char *dll_name )
731 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
732 /* ------------------- ELF DLL loader ------------------- */
738 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
740 /* dlopen failed; return a ptr to the error msg. */
742 if (errmsg == NULL) errmsg = "addDLL: unknown error";
749 # elif defined(OBJFORMAT_PEi386)
750 /* ------------------- Win32 DLL loader ------------------- */
758 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
760 /* See if we've already got it, and ignore if so. */
761 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
762 if (0 == strcmp(o_dll->name, dll_name))
766 /* The file name has no suffix (yet) so that we can try
767 both foo.dll and foo.drv
769 The documentation for LoadLibrary says:
770 If no file name extension is specified in the lpFileName
771 parameter, the default library extension .dll is
772 appended. However, the file name string can include a trailing
773 point character (.) to indicate that the module name has no
776 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
777 sprintf(buf, "%s.DLL", dll_name);
778 instance = LoadLibrary(buf);
779 if (instance == NULL) {
780 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
781 instance = LoadLibrary(buf);
782 if (instance == NULL) {
785 /* LoadLibrary failed; return a ptr to the error msg. */
786 return "addDLL: unknown error";
791 /* Add this DLL to the list of DLLs in which to search for symbols. */
792 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
793 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
794 strcpy(o_dll->name, dll_name);
795 o_dll->instance = instance;
796 o_dll->next = opened_dlls;
801 barf("addDLL: not implemented on this platform");
805 /* -----------------------------------------------------------------------------
806 * lookup a symbol in the hash table
809 lookupSymbol( char *lbl )
813 ASSERT(symhash != NULL);
814 val = lookupStrHashTable(symhash, lbl);
817 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
818 return dlsym(dl_prog_handle, lbl);
819 # elif defined(OBJFORMAT_PEi386)
822 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
823 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
825 /* HACK: if the name has an initial underscore, try stripping
826 it off & look that up first. I've yet to verify whether there's
827 a Rule that governs whether an initial '_' *should always* be
828 stripped off when mapping from import lib name to the DLL name.
830 sym = GetProcAddress(o_dll->instance, (lbl+1));
832 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
836 sym = GetProcAddress(o_dll->instance, lbl);
838 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
853 __attribute((unused))
855 lookupLocalSymbol( ObjectCode* oc, char *lbl )
859 val = lookupStrHashTable(oc->lochash, lbl);
869 /* -----------------------------------------------------------------------------
870 * Debugging aid: look in GHCi's object symbol tables for symbols
871 * within DELTA bytes of the specified address, and show their names.
874 void ghci_enquire ( char* addr );
876 void ghci_enquire ( char* addr )
881 const int DELTA = 64;
886 for (oc = objects; oc; oc = oc->next) {
887 for (i = 0; i < oc->n_symbols; i++) {
888 sym = oc->symbols[i];
889 if (sym == NULL) continue;
890 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
892 if (oc->lochash != NULL) {
893 a = lookupStrHashTable(oc->lochash, sym);
896 a = lookupStrHashTable(symhash, sym);
899 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
901 else if (addr-DELTA <= a && a <= addr+DELTA) {
902 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
909 #ifdef ia64_TARGET_ARCH
910 static unsigned int PLTSize(void);
913 /* -----------------------------------------------------------------------------
914 * Load an obj (populate the global symbol table, but don't resolve yet)
916 * Returns: 1 if ok, 0 on error.
919 loadObj( char *path )
933 /* fprintf(stderr, "loadObj %s\n", path ); */
935 /* Check that we haven't already loaded this object. Don't give up
936 at this stage; ocGetNames_* will barf later. */
940 for (o = objects; o; o = o->next) {
941 if (0 == strcmp(o->fileName, path))
947 "GHCi runtime linker: warning: looks like you're trying to load the\n"
948 "same object file twice:\n"
950 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
956 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
958 # if defined(OBJFORMAT_ELF)
959 oc->formatName = "ELF";
960 # elif defined(OBJFORMAT_PEi386)
961 oc->formatName = "PEi386";
962 # elif defined(OBJFORMAT_MACHO)
963 oc->formatName = "Mach-O";
966 barf("loadObj: not implemented on this platform");
970 if (r == -1) { return 0; }
972 /* sigh, strdup() isn't a POSIX function, so do it the long way */
973 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
974 strcpy(oc->fileName, path);
976 oc->fileSize = st.st_size;
979 oc->lochash = allocStrHashTable();
980 oc->proddables = NULL;
982 /* chain it onto the list of objects */
987 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
989 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
991 fd = open(path, O_RDONLY);
993 barf("loadObj: can't open `%s'", path);
995 pagesize = getpagesize();
997 #ifdef ia64_TARGET_ARCH
998 /* The PLT needs to be right before the object */
999 n = ROUND_UP(PLTSize(), pagesize);
1000 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1001 if (oc->plt == MAP_FAILED)
1002 barf("loadObj: can't allocate PLT");
1005 map_addr = oc->plt + n;
1008 n = ROUND_UP(oc->fileSize, pagesize);
1009 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1010 if (oc->image == MAP_FAILED)
1011 barf("loadObj: can't map `%s'", path);
1015 #else /* !USE_MMAP */
1017 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1019 /* load the image into memory */
1020 f = fopen(path, "rb");
1022 barf("loadObj: can't read `%s'", path);
1024 n = fread ( oc->image, 1, oc->fileSize, f );
1025 if (n != oc->fileSize)
1026 barf("loadObj: error whilst reading `%s'", path);
1030 #endif /* USE_MMAP */
1032 /* verify the in-memory image */
1033 # if defined(OBJFORMAT_ELF)
1034 r = ocVerifyImage_ELF ( oc );
1035 # elif defined(OBJFORMAT_PEi386)
1036 r = ocVerifyImage_PEi386 ( oc );
1037 # elif defined(OBJFORMAT_MACHO)
1038 r = ocVerifyImage_MachO ( oc );
1040 barf("loadObj: no verify method");
1042 if (!r) { return r; }
1044 /* build the symbol list for this image */
1045 # if defined(OBJFORMAT_ELF)
1046 r = ocGetNames_ELF ( oc );
1047 # elif defined(OBJFORMAT_PEi386)
1048 r = ocGetNames_PEi386 ( oc );
1049 # elif defined(OBJFORMAT_MACHO)
1050 r = ocGetNames_MachO ( oc );
1052 barf("loadObj: no getNames method");
1054 if (!r) { return r; }
1056 /* loaded, but not resolved yet */
1057 oc->status = OBJECT_LOADED;
1062 /* -----------------------------------------------------------------------------
1063 * resolve all the currently unlinked objects in memory
1065 * Returns: 1 if ok, 0 on error.
1075 for (oc = objects; oc; oc = oc->next) {
1076 if (oc->status != OBJECT_RESOLVED) {
1077 # if defined(OBJFORMAT_ELF)
1078 r = ocResolve_ELF ( oc );
1079 # elif defined(OBJFORMAT_PEi386)
1080 r = ocResolve_PEi386 ( oc );
1081 # elif defined(OBJFORMAT_MACHO)
1082 r = ocResolve_MachO ( oc );
1084 barf("resolveObjs: not implemented on this platform");
1086 if (!r) { return r; }
1087 oc->status = OBJECT_RESOLVED;
1093 /* -----------------------------------------------------------------------------
1094 * delete an object from the pool
1097 unloadObj( char *path )
1099 ObjectCode *oc, *prev;
1101 ASSERT(symhash != NULL);
1102 ASSERT(objects != NULL);
1107 for (oc = objects; oc; prev = oc, oc = oc->next) {
1108 if (!strcmp(oc->fileName,path)) {
1110 /* Remove all the mappings for the symbols within this
1115 for (i = 0; i < oc->n_symbols; i++) {
1116 if (oc->symbols[i] != NULL) {
1117 removeStrHashTable(symhash, oc->symbols[i], NULL);
1125 prev->next = oc->next;
1128 /* We're going to leave this in place, in case there are
1129 any pointers from the heap into it: */
1130 /* stgFree(oc->image); */
1131 stgFree(oc->fileName);
1132 stgFree(oc->symbols);
1133 stgFree(oc->sections);
1134 /* The local hash table should have been freed at the end
1135 of the ocResolve_ call on it. */
1136 ASSERT(oc->lochash == NULL);
1142 belch("unloadObj: can't find `%s' to unload", path);
1146 /* -----------------------------------------------------------------------------
1147 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1148 * which may be prodded during relocation, and abort if we try and write
1149 * outside any of these.
1151 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1154 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1155 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1159 pb->next = oc->proddables;
1160 oc->proddables = pb;
1163 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1166 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1167 char* s = (char*)(pb->start);
1168 char* e = s + pb->size - 1;
1169 char* a = (char*)addr;
1170 /* Assumes that the biggest fixup involves a 4-byte write. This
1171 probably needs to be changed to 8 (ie, +7) on 64-bit
1173 if (a >= s && (a+3) <= e) return;
1175 barf("checkProddableBlock: invalid fixup in runtime linker");
1178 /* -----------------------------------------------------------------------------
1179 * Section management.
1181 static void addSection ( ObjectCode* oc, SectionKind kind,
1182 void* start, void* end )
1184 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1188 s->next = oc->sections;
1191 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1192 start, ((char*)end)-1, end - start + 1, kind );
1198 /* --------------------------------------------------------------------------
1199 * PEi386 specifics (Win32 targets)
1200 * ------------------------------------------------------------------------*/
1202 /* The information for this linker comes from
1203 Microsoft Portable Executable
1204 and Common Object File Format Specification
1205 revision 5.1 January 1998
1206 which SimonM says comes from the MS Developer Network CDs.
1208 It can be found there (on older CDs), but can also be found
1211 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1213 (this is Rev 6.0 from February 1999).
1215 Things move, so if that fails, try searching for it via
1217 http://www.google.com/search?q=PE+COFF+specification
1219 The ultimate reference for the PE format is the Winnt.h
1220 header file that comes with the Platform SDKs; as always,
1221 implementations will drift wrt their documentation.
1223 A good background article on the PE format is Matt Pietrek's
1224 March 1994 article in Microsoft System Journal (MSJ)
1225 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1226 Win32 Portable Executable File Format." The info in there
1227 has recently been updated in a two part article in
1228 MSDN magazine, issues Feb and March 2002,
1229 "Inside Windows: An In-Depth Look into the Win32 Portable
1230 Executable File Format"
1232 John Levine's book "Linkers and Loaders" contains useful
1237 #if defined(OBJFORMAT_PEi386)
1241 typedef unsigned char UChar;
1242 typedef unsigned short UInt16;
1243 typedef unsigned int UInt32;
1250 UInt16 NumberOfSections;
1251 UInt32 TimeDateStamp;
1252 UInt32 PointerToSymbolTable;
1253 UInt32 NumberOfSymbols;
1254 UInt16 SizeOfOptionalHeader;
1255 UInt16 Characteristics;
1259 #define sizeof_COFF_header 20
1266 UInt32 VirtualAddress;
1267 UInt32 SizeOfRawData;
1268 UInt32 PointerToRawData;
1269 UInt32 PointerToRelocations;
1270 UInt32 PointerToLinenumbers;
1271 UInt16 NumberOfRelocations;
1272 UInt16 NumberOfLineNumbers;
1273 UInt32 Characteristics;
1277 #define sizeof_COFF_section 40
1284 UInt16 SectionNumber;
1287 UChar NumberOfAuxSymbols;
1291 #define sizeof_COFF_symbol 18
1296 UInt32 VirtualAddress;
1297 UInt32 SymbolTableIndex;
1302 #define sizeof_COFF_reloc 10
1305 /* From PE spec doc, section 3.3.2 */
1306 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1307 windows.h -- for the same purpose, but I want to know what I'm
1309 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1310 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1311 #define MYIMAGE_FILE_DLL 0x2000
1312 #define MYIMAGE_FILE_SYSTEM 0x1000
1313 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1314 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1315 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1317 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1318 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1319 #define MYIMAGE_SYM_CLASS_STATIC 3
1320 #define MYIMAGE_SYM_UNDEFINED 0
1322 /* From PE spec doc, section 4.1 */
1323 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1324 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1325 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1327 /* From PE spec doc, section 5.2.1 */
1328 #define MYIMAGE_REL_I386_DIR32 0x0006
1329 #define MYIMAGE_REL_I386_REL32 0x0014
1332 /* We use myindex to calculate array addresses, rather than
1333 simply doing the normal subscript thing. That's because
1334 some of the above structs have sizes which are not
1335 a whole number of words. GCC rounds their sizes up to a
1336 whole number of words, which means that the address calcs
1337 arising from using normal C indexing or pointer arithmetic
1338 are just plain wrong. Sigh.
1341 myindex ( int scale, void* base, int index )
1344 ((UChar*)base) + scale * index;
1349 printName ( UChar* name, UChar* strtab )
1351 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1352 UInt32 strtab_offset = * (UInt32*)(name+4);
1353 fprintf ( stderr, "%s", strtab + strtab_offset );
1356 for (i = 0; i < 8; i++) {
1357 if (name[i] == 0) break;
1358 fprintf ( stderr, "%c", name[i] );
1365 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1367 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1368 UInt32 strtab_offset = * (UInt32*)(name+4);
1369 strncpy ( dst, strtab+strtab_offset, dstSize );
1375 if (name[i] == 0) break;
1385 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1388 /* If the string is longer than 8 bytes, look in the
1389 string table for it -- this will be correctly zero terminated.
1391 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1392 UInt32 strtab_offset = * (UInt32*)(name+4);
1393 return ((UChar*)strtab) + strtab_offset;
1395 /* Otherwise, if shorter than 8 bytes, return the original,
1396 which by defn is correctly terminated.
1398 if (name[7]==0) return name;
1399 /* The annoying case: 8 bytes. Copy into a temporary
1400 (which is never freed ...)
1402 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1404 strncpy(newstr,name,8);
1410 /* Just compares the short names (first 8 chars) */
1411 static COFF_section *
1412 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1416 = (COFF_header*)(oc->image);
1417 COFF_section* sectab
1419 ((UChar*)(oc->image))
1420 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1422 for (i = 0; i < hdr->NumberOfSections; i++) {
1425 COFF_section* section_i
1427 myindex ( sizeof_COFF_section, sectab, i );
1428 n1 = (UChar*) &(section_i->Name);
1430 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1431 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1432 n1[6]==n2[6] && n1[7]==n2[7])
1441 zapTrailingAtSign ( UChar* sym )
1443 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1445 if (sym[0] == 0) return;
1447 while (sym[i] != 0) i++;
1450 while (j > 0 && my_isdigit(sym[j])) j--;
1451 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1457 ocVerifyImage_PEi386 ( ObjectCode* oc )
1462 COFF_section* sectab;
1463 COFF_symbol* symtab;
1465 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1466 hdr = (COFF_header*)(oc->image);
1467 sectab = (COFF_section*) (
1468 ((UChar*)(oc->image))
1469 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1471 symtab = (COFF_symbol*) (
1472 ((UChar*)(oc->image))
1473 + hdr->PointerToSymbolTable
1475 strtab = ((UChar*)symtab)
1476 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1478 if (hdr->Machine != 0x14c) {
1479 belch("Not x86 PEi386");
1482 if (hdr->SizeOfOptionalHeader != 0) {
1483 belch("PEi386 with nonempty optional header");
1486 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1487 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1488 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1489 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1490 belch("Not a PEi386 object file");
1493 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1494 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1495 belch("Invalid PEi386 word size or endiannness: %d",
1496 (int)(hdr->Characteristics));
1499 /* If the string table size is way crazy, this might indicate that
1500 there are more than 64k relocations, despite claims to the
1501 contrary. Hence this test. */
1502 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1504 if ( (*(UInt32*)strtab) > 600000 ) {
1505 /* Note that 600k has no special significance other than being
1506 big enough to handle the almost-2MB-sized lumps that
1507 constitute HSwin32*.o. */
1508 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1513 /* No further verification after this point; only debug printing. */
1515 IF_DEBUG(linker, i=1);
1516 if (i == 0) return 1;
1519 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1521 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1523 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1525 fprintf ( stderr, "\n" );
1527 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1529 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1531 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1533 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1535 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1537 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1539 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1541 /* Print the section table. */
1542 fprintf ( stderr, "\n" );
1543 for (i = 0; i < hdr->NumberOfSections; i++) {
1545 COFF_section* sectab_i
1547 myindex ( sizeof_COFF_section, sectab, i );
1554 printName ( sectab_i->Name, strtab );
1564 sectab_i->VirtualSize,
1565 sectab_i->VirtualAddress,
1566 sectab_i->SizeOfRawData,
1567 sectab_i->PointerToRawData,
1568 sectab_i->NumberOfRelocations,
1569 sectab_i->PointerToRelocations,
1570 sectab_i->PointerToRawData
1572 reltab = (COFF_reloc*) (
1573 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1576 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1577 /* If the relocation field (a short) has overflowed, the
1578 * real count can be found in the first reloc entry.
1580 * See Section 4.1 (last para) of the PE spec (rev6.0).
1582 COFF_reloc* rel = (COFF_reloc*)
1583 myindex ( sizeof_COFF_reloc, reltab, 0 );
1584 noRelocs = rel->VirtualAddress;
1587 noRelocs = sectab_i->NumberOfRelocations;
1591 for (; j < noRelocs; j++) {
1593 COFF_reloc* rel = (COFF_reloc*)
1594 myindex ( sizeof_COFF_reloc, reltab, j );
1596 " type 0x%-4x vaddr 0x%-8x name `",
1598 rel->VirtualAddress );
1599 sym = (COFF_symbol*)
1600 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1601 /* Hmm..mysterious looking offset - what's it for? SOF */
1602 printName ( sym->Name, strtab -10 );
1603 fprintf ( stderr, "'\n" );
1606 fprintf ( stderr, "\n" );
1608 fprintf ( stderr, "\n" );
1609 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1610 fprintf ( stderr, "---START of string table---\n");
1611 for (i = 4; i < *(Int32*)strtab; i++) {
1613 fprintf ( stderr, "\n"); else
1614 fprintf( stderr, "%c", strtab[i] );
1616 fprintf ( stderr, "--- END of string table---\n");
1618 fprintf ( stderr, "\n" );
1621 COFF_symbol* symtab_i;
1622 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1623 symtab_i = (COFF_symbol*)
1624 myindex ( sizeof_COFF_symbol, symtab, i );
1630 printName ( symtab_i->Name, strtab );
1639 (Int32)(symtab_i->SectionNumber),
1640 (UInt32)symtab_i->Type,
1641 (UInt32)symtab_i->StorageClass,
1642 (UInt32)symtab_i->NumberOfAuxSymbols
1644 i += symtab_i->NumberOfAuxSymbols;
1648 fprintf ( stderr, "\n" );
1654 ocGetNames_PEi386 ( ObjectCode* oc )
1657 COFF_section* sectab;
1658 COFF_symbol* symtab;
1665 hdr = (COFF_header*)(oc->image);
1666 sectab = (COFF_section*) (
1667 ((UChar*)(oc->image))
1668 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1670 symtab = (COFF_symbol*) (
1671 ((UChar*)(oc->image))
1672 + hdr->PointerToSymbolTable
1674 strtab = ((UChar*)(oc->image))
1675 + hdr->PointerToSymbolTable
1676 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1678 /* Allocate space for any (local, anonymous) .bss sections. */
1680 for (i = 0; i < hdr->NumberOfSections; i++) {
1682 COFF_section* sectab_i
1684 myindex ( sizeof_COFF_section, sectab, i );
1685 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1686 if (sectab_i->VirtualSize == 0) continue;
1687 /* This is a non-empty .bss section. Allocate zeroed space for
1688 it, and set its PointerToRawData field such that oc->image +
1689 PointerToRawData == addr_of_zeroed_space. */
1690 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1691 "ocGetNames_PEi386(anonymous bss)");
1692 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1693 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1694 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1697 /* Copy section information into the ObjectCode. */
1699 for (i = 0; i < hdr->NumberOfSections; i++) {
1705 = SECTIONKIND_OTHER;
1706 COFF_section* sectab_i
1708 myindex ( sizeof_COFF_section, sectab, i );
1709 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1712 /* I'm sure this is the Right Way to do it. However, the
1713 alternative of testing the sectab_i->Name field seems to
1714 work ok with Cygwin.
1716 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1717 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1718 kind = SECTIONKIND_CODE_OR_RODATA;
1721 if (0==strcmp(".text",sectab_i->Name) ||
1722 0==strcmp(".rodata",sectab_i->Name))
1723 kind = SECTIONKIND_CODE_OR_RODATA;
1724 if (0==strcmp(".data",sectab_i->Name) ||
1725 0==strcmp(".bss",sectab_i->Name))
1726 kind = SECTIONKIND_RWDATA;
1728 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1729 sz = sectab_i->SizeOfRawData;
1730 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1732 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1733 end = start + sz - 1;
1735 if (kind == SECTIONKIND_OTHER
1736 /* Ignore sections called which contain stabs debugging
1738 && 0 != strcmp(".stab", sectab_i->Name)
1739 && 0 != strcmp(".stabstr", sectab_i->Name)
1741 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1745 if (kind != SECTIONKIND_OTHER && end >= start) {
1746 addSection(oc, kind, start, end);
1747 addProddableBlock(oc, start, end - start + 1);
1751 /* Copy exported symbols into the ObjectCode. */
1753 oc->n_symbols = hdr->NumberOfSymbols;
1754 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1755 "ocGetNames_PEi386(oc->symbols)");
1756 /* Call me paranoid; I don't care. */
1757 for (i = 0; i < oc->n_symbols; i++)
1758 oc->symbols[i] = NULL;
1762 COFF_symbol* symtab_i;
1763 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1764 symtab_i = (COFF_symbol*)
1765 myindex ( sizeof_COFF_symbol, symtab, i );
1769 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1770 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1771 /* This symbol is global and defined, viz, exported */
1772 /* for MYIMAGE_SYMCLASS_EXTERNAL
1773 && !MYIMAGE_SYM_UNDEFINED,
1774 the address of the symbol is:
1775 address of relevant section + offset in section
1777 COFF_section* sectabent
1778 = (COFF_section*) myindex ( sizeof_COFF_section,
1780 symtab_i->SectionNumber-1 );
1781 addr = ((UChar*)(oc->image))
1782 + (sectabent->PointerToRawData
1786 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1787 && symtab_i->Value > 0) {
1788 /* This symbol isn't in any section at all, ie, global bss.
1789 Allocate zeroed space for it. */
1790 addr = stgCallocBytes(1, symtab_i->Value,
1791 "ocGetNames_PEi386(non-anonymous bss)");
1792 addSection(oc, SECTIONKIND_RWDATA, addr,
1793 ((UChar*)addr) + symtab_i->Value - 1);
1794 addProddableBlock(oc, addr, symtab_i->Value);
1795 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1798 if (addr != NULL ) {
1799 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1800 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1801 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1802 ASSERT(i >= 0 && i < oc->n_symbols);
1803 /* cstring_from_COFF_symbol_name always succeeds. */
1804 oc->symbols[i] = sname;
1805 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1809 "IGNORING symbol %d\n"
1813 printName ( symtab_i->Name, strtab );
1822 (Int32)(symtab_i->SectionNumber),
1823 (UInt32)symtab_i->Type,
1824 (UInt32)symtab_i->StorageClass,
1825 (UInt32)symtab_i->NumberOfAuxSymbols
1830 i += symtab_i->NumberOfAuxSymbols;
1839 ocResolve_PEi386 ( ObjectCode* oc )
1842 COFF_section* sectab;
1843 COFF_symbol* symtab;
1853 /* ToDo: should be variable-sized? But is at least safe in the
1854 sense of buffer-overrun-proof. */
1856 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1858 hdr = (COFF_header*)(oc->image);
1859 sectab = (COFF_section*) (
1860 ((UChar*)(oc->image))
1861 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1863 symtab = (COFF_symbol*) (
1864 ((UChar*)(oc->image))
1865 + hdr->PointerToSymbolTable
1867 strtab = ((UChar*)(oc->image))
1868 + hdr->PointerToSymbolTable
1869 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1871 for (i = 0; i < hdr->NumberOfSections; i++) {
1872 COFF_section* sectab_i
1874 myindex ( sizeof_COFF_section, sectab, i );
1877 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1880 /* Ignore sections called which contain stabs debugging
1882 if (0 == strcmp(".stab", sectab_i->Name)
1883 || 0 == strcmp(".stabstr", sectab_i->Name))
1886 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1887 /* If the relocation field (a short) has overflowed, the
1888 * real count can be found in the first reloc entry.
1890 * See Section 4.1 (last para) of the PE spec (rev6.0).
1892 COFF_reloc* rel = (COFF_reloc*)
1893 myindex ( sizeof_COFF_reloc, reltab, 0 );
1894 noRelocs = rel->VirtualAddress;
1895 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1898 noRelocs = sectab_i->NumberOfRelocations;
1903 for (; j < noRelocs; j++) {
1905 COFF_reloc* reltab_j
1907 myindex ( sizeof_COFF_reloc, reltab, j );
1909 /* the location to patch */
1911 ((UChar*)(oc->image))
1912 + (sectab_i->PointerToRawData
1913 + reltab_j->VirtualAddress
1914 - sectab_i->VirtualAddress )
1916 /* the existing contents of pP */
1918 /* the symbol to connect to */
1919 sym = (COFF_symbol*)
1920 myindex ( sizeof_COFF_symbol,
1921 symtab, reltab_j->SymbolTableIndex );
1924 "reloc sec %2d num %3d: type 0x%-4x "
1925 "vaddr 0x%-8x name `",
1927 (UInt32)reltab_j->Type,
1928 reltab_j->VirtualAddress );
1929 printName ( sym->Name, strtab );
1930 fprintf ( stderr, "'\n" ));
1932 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1933 COFF_section* section_sym
1934 = findPEi386SectionCalled ( oc, sym->Name );
1936 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1939 S = ((UInt32)(oc->image))
1940 + (section_sym->PointerToRawData
1943 copyName ( sym->Name, strtab, symbol, 1000-1 );
1944 (void*)S = lookupLocalSymbol( oc, symbol );
1945 if ((void*)S != NULL) goto foundit;
1946 (void*)S = lookupSymbol( symbol );
1947 if ((void*)S != NULL) goto foundit;
1948 zapTrailingAtSign ( symbol );
1949 (void*)S = lookupLocalSymbol( oc, symbol );
1950 if ((void*)S != NULL) goto foundit;
1951 (void*)S = lookupSymbol( symbol );
1952 if ((void*)S != NULL) goto foundit;
1953 /* Newline first because the interactive linker has printed "linking..." */
1954 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1958 checkProddableBlock(oc, pP);
1959 switch (reltab_j->Type) {
1960 case MYIMAGE_REL_I386_DIR32:
1963 case MYIMAGE_REL_I386_REL32:
1964 /* Tricky. We have to insert a displacement at
1965 pP which, when added to the PC for the _next_
1966 insn, gives the address of the target (S).
1967 Problem is to know the address of the next insn
1968 when we only know pP. We assume that this
1969 literal field is always the last in the insn,
1970 so that the address of the next insn is pP+4
1971 -- hence the constant 4.
1972 Also I don't know if A should be added, but so
1973 far it has always been zero.
1976 *pP = S - ((UInt32)pP) - 4;
1979 belch("%s: unhandled PEi386 relocation type %d",
1980 oc->fileName, reltab_j->Type);
1987 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1991 #endif /* defined(OBJFORMAT_PEi386) */
1994 /* --------------------------------------------------------------------------
1996 * ------------------------------------------------------------------------*/
1998 #if defined(OBJFORMAT_ELF)
2003 #if defined(sparc_TARGET_ARCH)
2004 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2005 #elif defined(i386_TARGET_ARCH)
2006 # define ELF_TARGET_386 /* Used inside <elf.h> */
2007 #elif defined (ia64_TARGET_ARCH)
2008 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2010 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2011 # define ELF_NEED_GOT /* needs Global Offset Table */
2012 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2018 * Define a set of types which can be used for both ELF32 and ELF64
2022 #define ELFCLASS ELFCLASS64
2023 #define Elf_Addr Elf64_Addr
2024 #define Elf_Word Elf64_Word
2025 #define Elf_Sword Elf64_Sword
2026 #define Elf_Ehdr Elf64_Ehdr
2027 #define Elf_Phdr Elf64_Phdr
2028 #define Elf_Shdr Elf64_Shdr
2029 #define Elf_Sym Elf64_Sym
2030 #define Elf_Rel Elf64_Rel
2031 #define Elf_Rela Elf64_Rela
2032 #define ELF_ST_TYPE ELF64_ST_TYPE
2033 #define ELF_ST_BIND ELF64_ST_BIND
2034 #define ELF_R_TYPE ELF64_R_TYPE
2035 #define ELF_R_SYM ELF64_R_SYM
2037 #define ELFCLASS ELFCLASS32
2038 #define Elf_Addr Elf32_Addr
2039 #define Elf_Word Elf32_Word
2040 #define Elf_Sword Elf32_Sword
2041 #define Elf_Ehdr Elf32_Ehdr
2042 #define Elf_Phdr Elf32_Phdr
2043 #define Elf_Shdr Elf32_Shdr
2044 #define Elf_Sym Elf32_Sym
2045 #define Elf_Rel Elf32_Rel
2046 #define Elf_Rela Elf32_Rela
2048 #define ELF_ST_TYPE ELF32_ST_TYPE
2051 #define ELF_ST_BIND ELF32_ST_BIND
2054 #define ELF_R_TYPE ELF32_R_TYPE
2057 #define ELF_R_SYM ELF32_R_SYM
2063 * Functions to allocate entries in dynamic sections. Currently we simply
2064 * preallocate a large number, and we don't check if a entry for the given
2065 * target already exists (a linear search is too slow). Ideally these
2066 * entries would be associated with symbols.
2069 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2070 #define GOT_SIZE 0x20000
2071 #define FUNCTION_TABLE_SIZE 0x10000
2072 #define PLT_SIZE 0x08000
2075 static Elf_Addr got[GOT_SIZE];
2076 static unsigned int gotIndex;
2077 static Elf_Addr gp_val = (Elf_Addr)got;
2080 allocateGOTEntry(Elf_Addr target)
2084 if (gotIndex >= GOT_SIZE)
2085 barf("Global offset table overflow");
2087 entry = &got[gotIndex++];
2089 return (Elf_Addr)entry;
2093 #ifdef ELF_FUNCTION_DESC
2099 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2100 static unsigned int functionTableIndex;
2103 allocateFunctionDesc(Elf_Addr target)
2105 FunctionDesc *entry;
2107 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2108 barf("Function table overflow");
2110 entry = &functionTable[functionTableIndex++];
2112 entry->gp = (Elf_Addr)gp_val;
2113 return (Elf_Addr)entry;
2117 copyFunctionDesc(Elf_Addr target)
2119 FunctionDesc *olddesc = (FunctionDesc *)target;
2120 FunctionDesc *newdesc;
2122 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2123 newdesc->gp = olddesc->gp;
2124 return (Elf_Addr)newdesc;
2129 #ifdef ia64_TARGET_ARCH
2130 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2131 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2133 static unsigned char plt_code[] =
2135 /* taken from binutils bfd/elfxx-ia64.c */
2136 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2137 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2138 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2139 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2140 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2141 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2144 /* If we can't get to the function descriptor via gp, take a local copy of it */
2145 #define PLT_RELOC(code, target) { \
2146 Elf64_Sxword rel_value = target - gp_val; \
2147 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2148 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2150 ia64_reloc_gprel22((Elf_Addr)code, target); \
2155 unsigned char code[sizeof(plt_code)];
2159 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2161 PLTEntry *plt = (PLTEntry *)oc->plt;
2164 if (oc->pltIndex >= PLT_SIZE)
2165 barf("Procedure table overflow");
2167 entry = &plt[oc->pltIndex++];
2168 memcpy(entry->code, plt_code, sizeof(entry->code));
2169 PLT_RELOC(entry->code, target);
2170 return (Elf_Addr)entry;
2176 return (PLT_SIZE * sizeof(PLTEntry));
2182 * Generic ELF functions
2186 findElfSection ( void* objImage, Elf_Word sh_type )
2188 char* ehdrC = (char*)objImage;
2189 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2190 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2191 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2195 for (i = 0; i < ehdr->e_shnum; i++) {
2196 if (shdr[i].sh_type == sh_type
2197 /* Ignore the section header's string table. */
2198 && i != ehdr->e_shstrndx
2199 /* Ignore string tables named .stabstr, as they contain
2201 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2203 ptr = ehdrC + shdr[i].sh_offset;
2210 #if defined(ia64_TARGET_ARCH)
2212 findElfSegment ( void* objImage, Elf_Addr vaddr )
2214 char* ehdrC = (char*)objImage;
2215 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2216 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2217 Elf_Addr segaddr = 0;
2220 for (i = 0; i < ehdr->e_phnum; i++) {
2221 segaddr = phdr[i].p_vaddr;
2222 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2230 ocVerifyImage_ELF ( ObjectCode* oc )
2234 int i, j, nent, nstrtab, nsymtabs;
2238 char* ehdrC = (char*)(oc->image);
2239 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2241 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2242 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2243 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2244 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2245 belch("%s: not an ELF object", oc->fileName);
2249 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2250 belch("%s: unsupported ELF format", oc->fileName);
2254 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2255 IF_DEBUG(linker,belch( "Is little-endian" ));
2257 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2258 IF_DEBUG(linker,belch( "Is big-endian" ));
2260 belch("%s: unknown endiannness", oc->fileName);
2264 if (ehdr->e_type != ET_REL) {
2265 belch("%s: not a relocatable object (.o) file", oc->fileName);
2268 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2270 IF_DEBUG(linker,belch( "Architecture is " ));
2271 switch (ehdr->e_machine) {
2272 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2273 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2275 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2277 default: IF_DEBUG(linker,belch( "unknown" ));
2278 belch("%s: unknown architecture", oc->fileName);
2282 IF_DEBUG(linker,belch(
2283 "\nSection header table: start %d, n_entries %d, ent_size %d",
2284 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2286 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2288 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2290 if (ehdr->e_shstrndx == SHN_UNDEF) {
2291 belch("%s: no section header string table", oc->fileName);
2294 IF_DEBUG(linker,belch( "Section header string table is section %d",
2296 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2299 for (i = 0; i < ehdr->e_shnum; i++) {
2300 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2301 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2302 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2303 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2304 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2305 ehdrC + shdr[i].sh_offset,
2306 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2308 if (shdr[i].sh_type == SHT_REL) {
2309 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2310 } else if (shdr[i].sh_type == SHT_RELA) {
2311 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2313 IF_DEBUG(linker,fprintf(stderr," "));
2316 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2320 IF_DEBUG(linker,belch( "\nString tables" ));
2323 for (i = 0; i < ehdr->e_shnum; i++) {
2324 if (shdr[i].sh_type == SHT_STRTAB
2325 /* Ignore the section header's string table. */
2326 && i != ehdr->e_shstrndx
2327 /* Ignore string tables named .stabstr, as they contain
2329 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2331 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2332 strtab = ehdrC + shdr[i].sh_offset;
2337 belch("%s: no string tables, or too many", oc->fileName);
2342 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2343 for (i = 0; i < ehdr->e_shnum; i++) {
2344 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2345 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2347 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2348 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2349 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2351 shdr[i].sh_size % sizeof(Elf_Sym)
2353 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2354 belch("%s: non-integral number of symbol table entries", oc->fileName);
2357 for (j = 0; j < nent; j++) {
2358 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2359 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2360 (int)stab[j].st_shndx,
2361 (int)stab[j].st_size,
2362 (char*)stab[j].st_value ));
2364 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2365 switch (ELF_ST_TYPE(stab[j].st_info)) {
2366 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2367 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2368 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2369 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2370 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2371 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2373 IF_DEBUG(linker,fprintf(stderr, " " ));
2375 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2376 switch (ELF_ST_BIND(stab[j].st_info)) {
2377 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2378 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2379 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2380 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2382 IF_DEBUG(linker,fprintf(stderr, " " ));
2384 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2388 if (nsymtabs == 0) {
2389 belch("%s: didn't find any symbol tables", oc->fileName);
2398 ocGetNames_ELF ( ObjectCode* oc )
2403 char* ehdrC = (char*)(oc->image);
2404 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2405 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2406 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2408 ASSERT(symhash != NULL);
2411 belch("%s: no strtab", oc->fileName);
2416 for (i = 0; i < ehdr->e_shnum; i++) {
2417 /* Figure out what kind of section it is. Logic derived from
2418 Figure 1.14 ("Special Sections") of the ELF document
2419 ("Portable Formats Specification, Version 1.1"). */
2420 Elf_Shdr hdr = shdr[i];
2421 SectionKind kind = SECTIONKIND_OTHER;
2424 if (hdr.sh_type == SHT_PROGBITS
2425 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2426 /* .text-style section */
2427 kind = SECTIONKIND_CODE_OR_RODATA;
2430 if (hdr.sh_type == SHT_PROGBITS
2431 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2432 /* .data-style section */
2433 kind = SECTIONKIND_RWDATA;
2436 if (hdr.sh_type == SHT_PROGBITS
2437 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2438 /* .rodata-style section */
2439 kind = SECTIONKIND_CODE_OR_RODATA;
2442 if (hdr.sh_type == SHT_NOBITS
2443 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2444 /* .bss-style section */
2445 kind = SECTIONKIND_RWDATA;
2449 if (is_bss && shdr[i].sh_size > 0) {
2450 /* This is a non-empty .bss section. Allocate zeroed space for
2451 it, and set its .sh_offset field such that
2452 ehdrC + .sh_offset == addr_of_zeroed_space. */
2453 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2454 "ocGetNames_ELF(BSS)");
2455 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2457 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2458 zspace, shdr[i].sh_size);
2462 /* fill in the section info */
2463 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2464 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2465 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2466 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2469 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2471 /* copy stuff into this module's object symbol table */
2472 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2473 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2475 oc->n_symbols = nent;
2476 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2477 "ocGetNames_ELF(oc->symbols)");
2479 for (j = 0; j < nent; j++) {
2481 char isLocal = FALSE; /* avoids uninit-var warning */
2483 char* nm = strtab + stab[j].st_name;
2484 int secno = stab[j].st_shndx;
2486 /* Figure out if we want to add it; if so, set ad to its
2487 address. Otherwise leave ad == NULL. */
2489 if (secno == SHN_COMMON) {
2491 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2493 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2494 stab[j].st_size, nm);
2496 /* Pointless to do addProddableBlock() for this area,
2497 since the linker should never poke around in it. */
2500 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2501 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2503 /* and not an undefined symbol */
2504 && stab[j].st_shndx != SHN_UNDEF
2505 /* and not in a "special section" */
2506 && stab[j].st_shndx < SHN_LORESERVE
2508 /* and it's a not a section or string table or anything silly */
2509 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2510 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2511 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2514 /* Section 0 is the undefined section, hence > and not >=. */
2515 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2517 if (shdr[secno].sh_type == SHT_NOBITS) {
2518 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2519 stab[j].st_size, stab[j].st_value, nm);
2522 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2523 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2526 #ifdef ELF_FUNCTION_DESC
2527 /* dlsym() and the initialisation table both give us function
2528 * descriptors, so to be consistent we store function descriptors
2529 * in the symbol table */
2530 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2531 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2533 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2534 ad, oc->fileName, nm ));
2539 /* And the decision is ... */
2543 oc->symbols[j] = nm;
2546 /* Ignore entirely. */
2548 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2552 IF_DEBUG(linker,belch( "skipping `%s'",
2553 strtab + stab[j].st_name ));
2556 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2557 (int)ELF_ST_BIND(stab[j].st_info),
2558 (int)ELF_ST_TYPE(stab[j].st_info),
2559 (int)stab[j].st_shndx,
2560 strtab + stab[j].st_name
2563 oc->symbols[j] = NULL;
2572 /* Do ELF relocations which lack an explicit addend. All x86-linux
2573 relocations appear to be of this form. */
2575 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2576 Elf_Shdr* shdr, int shnum,
2577 Elf_Sym* stab, char* strtab )
2582 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2583 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2584 int target_shndx = shdr[shnum].sh_info;
2585 int symtab_shndx = shdr[shnum].sh_link;
2587 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2588 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2589 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2590 target_shndx, symtab_shndx ));
2592 for (j = 0; j < nent; j++) {
2593 Elf_Addr offset = rtab[j].r_offset;
2594 Elf_Addr info = rtab[j].r_info;
2596 Elf_Addr P = ((Elf_Addr)targ) + offset;
2597 Elf_Word* pP = (Elf_Word*)P;
2602 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2603 j, (void*)offset, (void*)info ));
2605 IF_DEBUG(linker,belch( " ZERO" ));
2608 Elf_Sym sym = stab[ELF_R_SYM(info)];
2609 /* First see if it is a local symbol. */
2610 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2611 /* Yes, so we can get the address directly from the ELF symbol
2613 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2615 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2616 + stab[ELF_R_SYM(info)].st_value);
2619 /* No, so look up the name in our global table. */
2620 symbol = strtab + sym.st_name;
2621 (void*)S = lookupSymbol( symbol );
2624 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2627 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2630 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2631 (void*)P, (void*)S, (void*)A ));
2632 checkProddableBlock ( oc, pP );
2636 switch (ELF_R_TYPE(info)) {
2637 # ifdef i386_TARGET_ARCH
2638 case R_386_32: *pP = value; break;
2639 case R_386_PC32: *pP = value - P; break;
2642 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2643 oc->fileName, ELF_R_TYPE(info));
2651 /* Do ELF relocations for which explicit addends are supplied.
2652 sparc-solaris relocations appear to be of this form. */
2654 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2655 Elf_Shdr* shdr, int shnum,
2656 Elf_Sym* stab, char* strtab )
2661 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2662 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2663 int target_shndx = shdr[shnum].sh_info;
2664 int symtab_shndx = shdr[shnum].sh_link;
2666 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2667 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2668 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2669 target_shndx, symtab_shndx ));
2671 for (j = 0; j < nent; j++) {
2672 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2673 /* This #ifdef only serves to avoid unused-var warnings. */
2674 Elf_Addr offset = rtab[j].r_offset;
2675 Elf_Addr P = targ + offset;
2677 Elf_Addr info = rtab[j].r_info;
2678 Elf_Addr A = rtab[j].r_addend;
2681 # if defined(sparc_TARGET_ARCH)
2682 Elf_Word* pP = (Elf_Word*)P;
2684 # elif defined(ia64_TARGET_ARCH)
2685 Elf64_Xword *pP = (Elf64_Xword *)P;
2689 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2690 j, (void*)offset, (void*)info,
2693 IF_DEBUG(linker,belch( " ZERO" ));
2696 Elf_Sym sym = stab[ELF_R_SYM(info)];
2697 /* First see if it is a local symbol. */
2698 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2699 /* Yes, so we can get the address directly from the ELF symbol
2701 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2703 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2704 + stab[ELF_R_SYM(info)].st_value);
2705 #ifdef ELF_FUNCTION_DESC
2706 /* Make a function descriptor for this function */
2707 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2708 S = allocateFunctionDesc(S + A);
2713 /* No, so look up the name in our global table. */
2714 symbol = strtab + sym.st_name;
2715 (void*)S = lookupSymbol( symbol );
2717 #ifdef ELF_FUNCTION_DESC
2718 /* If a function, already a function descriptor - we would
2719 have to copy it to add an offset. */
2720 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2721 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2725 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2728 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2731 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2732 (void*)P, (void*)S, (void*)A ));
2733 /* checkProddableBlock ( oc, (void*)P ); */
2737 switch (ELF_R_TYPE(info)) {
2738 # if defined(sparc_TARGET_ARCH)
2739 case R_SPARC_WDISP30:
2740 w1 = *pP & 0xC0000000;
2741 w2 = (Elf_Word)((value - P) >> 2);
2742 ASSERT((w2 & 0xC0000000) == 0);
2747 w1 = *pP & 0xFFC00000;
2748 w2 = (Elf_Word)(value >> 10);
2749 ASSERT((w2 & 0xFFC00000) == 0);
2755 w2 = (Elf_Word)(value & 0x3FF);
2756 ASSERT((w2 & ~0x3FF) == 0);
2760 /* According to the Sun documentation:
2762 This relocation type resembles R_SPARC_32, except it refers to an
2763 unaligned word. That is, the word to be relocated must be treated
2764 as four separate bytes with arbitrary alignment, not as a word
2765 aligned according to the architecture requirements.
2767 (JRS: which means that freeloading on the R_SPARC_32 case
2768 is probably wrong, but hey ...)
2772 w2 = (Elf_Word)value;
2775 # elif defined(ia64_TARGET_ARCH)
2776 case R_IA64_DIR64LSB:
2777 case R_IA64_FPTR64LSB:
2780 case R_IA64_PCREL64LSB:
2783 case R_IA64_SEGREL64LSB:
2784 addr = findElfSegment(ehdrC, value);
2787 case R_IA64_GPREL22:
2788 ia64_reloc_gprel22(P, value);
2790 case R_IA64_LTOFF22:
2791 case R_IA64_LTOFF22X:
2792 case R_IA64_LTOFF_FPTR22:
2793 addr = allocateGOTEntry(value);
2794 ia64_reloc_gprel22(P, addr);
2796 case R_IA64_PCREL21B:
2797 ia64_reloc_pcrel21(P, S, oc);
2800 /* This goes with R_IA64_LTOFF22X and points to the load to
2801 * convert into a move. We don't implement relaxation. */
2805 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2806 oc->fileName, ELF_R_TYPE(info));
2815 ocResolve_ELF ( ObjectCode* oc )
2819 Elf_Sym* stab = NULL;
2820 char* ehdrC = (char*)(oc->image);
2821 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2822 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2823 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2825 /* first find "the" symbol table */
2826 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2828 /* also go find the string table */
2829 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2831 if (stab == NULL || strtab == NULL) {
2832 belch("%s: can't find string or symbol table", oc->fileName);
2836 /* Process the relocation sections. */
2837 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2839 /* Skip sections called ".rel.stab". These appear to contain
2840 relocation entries that, when done, make the stabs debugging
2841 info point at the right places. We ain't interested in all
2843 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2846 if (shdr[shnum].sh_type == SHT_REL ) {
2847 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2848 shnum, stab, strtab );
2852 if (shdr[shnum].sh_type == SHT_RELA) {
2853 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2854 shnum, stab, strtab );
2859 /* Free the local symbol table; we won't need it again. */
2860 freeHashTable(oc->lochash, NULL);
2868 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2869 * at the front. The following utility functions pack and unpack instructions, and
2870 * take care of the most common relocations.
2873 #ifdef ia64_TARGET_ARCH
2876 ia64_extract_instruction(Elf64_Xword *target)
2879 int slot = (Elf_Addr)target & 3;
2880 (Elf_Addr)target &= ~3;
2888 return ((w1 >> 5) & 0x1ffffffffff);
2890 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2894 barf("ia64_extract_instruction: invalid slot %p", target);
2899 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2901 int slot = (Elf_Addr)target & 3;
2902 (Elf_Addr)target &= ~3;
2907 *target |= value << 5;
2910 *target |= value << 46;
2911 *(target+1) |= value >> 18;
2914 *(target+1) |= value << 23;
2920 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2922 Elf64_Xword instruction;
2923 Elf64_Sxword rel_value;
2925 rel_value = value - gp_val;
2926 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2927 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2929 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2930 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2931 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2932 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2933 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2934 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2938 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2940 Elf64_Xword instruction;
2941 Elf64_Sxword rel_value;
2944 entry = allocatePLTEntry(value, oc);
2946 rel_value = (entry >> 4) - (target >> 4);
2947 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2948 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2950 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2951 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2952 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2953 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2960 /* --------------------------------------------------------------------------
2962 * ------------------------------------------------------------------------*/
2964 #if defined(OBJFORMAT_MACHO)
2967 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2968 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2970 I hereby formally apologize for the hackish nature of this code.
2971 Things that need to be done:
2972 *) get common symbols and .bss sections to work properly.
2973 Haskell modules seem to work, but C modules can cause problems
2974 *) implement ocVerifyImage_MachO
2975 *) add more sanity checks. The current code just has to segfault if there's a
2979 static int ocVerifyImage_MachO(ObjectCode* oc)
2981 // FIXME: do some verifying here
2985 static int resolveImports(
2988 struct symtab_command *symLC,
2989 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2990 unsigned long *indirectSyms,
2991 struct nlist *nlist)
2995 for(i=0;i*4<sect->size;i++)
2997 // according to otool, reserved1 contains the first index into the indirect symbol table
2998 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2999 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3002 if((symbol->n_type & N_TYPE) == N_UNDF
3003 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3004 addr = (void*) (symbol->n_value);
3005 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3008 addr = lookupSymbol(nm);
3011 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3015 ((void**)(image + sect->offset))[i] = addr;
3021 static int relocateSection(char *image,
3022 struct symtab_command *symLC, struct nlist *nlist,
3023 struct section* sections, struct section *sect)
3025 struct relocation_info *relocs;
3028 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3030 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3034 relocs = (struct relocation_info*) (image + sect->reloff);
3038 if(relocs[i].r_address & R_SCATTERED)
3040 struct scattered_relocation_info *scat =
3041 (struct scattered_relocation_info*) &relocs[i];
3045 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3047 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3049 *word = scat->r_value + sect->offset + ((long) image);
3053 continue; // FIXME: I hope it's OK to ignore all the others.
3057 struct relocation_info *reloc = &relocs[i];
3058 if(reloc->r_pcrel && !reloc->r_extern)
3061 if(reloc->r_length == 2)
3063 unsigned long word = 0;
3065 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3067 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3071 else if(reloc->r_type == PPC_RELOC_LO16)
3073 word = ((unsigned short*) wordPtr)[1];
3074 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3076 else if(reloc->r_type == PPC_RELOC_HI16)
3078 word = ((unsigned short*) wordPtr)[1] << 16;
3079 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3081 else if(reloc->r_type == PPC_RELOC_HA16)
3083 word = ((unsigned short*) wordPtr)[1] << 16;
3084 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3086 else if(reloc->r_type == PPC_RELOC_BR24)
3089 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3093 if(!reloc->r_extern)
3096 sections[reloc->r_symbolnum-1].offset
3097 - sections[reloc->r_symbolnum-1].addr
3104 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3105 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3106 word = (unsigned long) (lookupSymbol(nm));
3109 belch("\nunknown symbol `%s'", nm);
3114 word -= ((long)image) + sect->offset + reloc->r_address;
3117 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3122 else if(reloc->r_type == PPC_RELOC_LO16)
3124 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3127 else if(reloc->r_type == PPC_RELOC_HI16)
3129 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3132 else if(reloc->r_type == PPC_RELOC_HA16)
3134 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3135 + ((word & (1<<15)) ? 1 : 0);
3138 else if(reloc->r_type == PPC_RELOC_BR24)
3140 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3144 barf("\nunknown relocation %d",reloc->r_type);
3151 static int ocGetNames_MachO(ObjectCode* oc)
3153 char *image = (char*) oc->image;
3154 struct mach_header *header = (struct mach_header*) image;
3155 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3156 unsigned i,curSymbol;
3157 struct segment_command *segLC = NULL;
3158 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3159 struct symtab_command *symLC = NULL;
3160 struct dysymtab_command *dsymLC = NULL;
3161 struct nlist *nlist;
3162 unsigned long commonSize = 0;
3163 char *commonStorage = NULL;
3164 unsigned long commonCounter;
3166 for(i=0;i<header->ncmds;i++)
3168 if(lc->cmd == LC_SEGMENT)
3169 segLC = (struct segment_command*) lc;
3170 else if(lc->cmd == LC_SYMTAB)
3171 symLC = (struct symtab_command*) lc;
3172 else if(lc->cmd == LC_DYSYMTAB)
3173 dsymLC = (struct dysymtab_command*) lc;
3174 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3177 sections = (struct section*) (segLC+1);
3178 nlist = (struct nlist*) (image + symLC->symoff);
3180 for(i=0;i<segLC->nsects;i++)
3182 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3183 la_ptrs = §ions[i];
3184 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3185 nl_ptrs = §ions[i];
3187 // for now, only add __text and __const to the sections table
3188 else if(!strcmp(sections[i].sectname,"__text"))
3189 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3190 (void*) (image + sections[i].offset),
3191 (void*) (image + sections[i].offset + sections[i].size));
3192 else if(!strcmp(sections[i].sectname,"__const"))
3193 addSection(oc, SECTIONKIND_RWDATA,
3194 (void*) (image + sections[i].offset),
3195 (void*) (image + sections[i].offset + sections[i].size));
3196 else if(!strcmp(sections[i].sectname,"__data"))
3197 addSection(oc, SECTIONKIND_RWDATA,
3198 (void*) (image + sections[i].offset),
3199 (void*) (image + sections[i].offset + sections[i].size));
3202 // count external symbols defined here
3204 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3206 if((nlist[i].n_type & N_TYPE) == N_SECT)
3209 for(i=0;i<symLC->nsyms;i++)
3211 if((nlist[i].n_type & N_TYPE) == N_UNDF
3212 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3214 commonSize += nlist[i].n_value;
3218 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3219 "ocGetNames_MachO(oc->symbols)");
3221 // insert symbols into hash table
3222 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3224 if((nlist[i].n_type & N_TYPE) == N_SECT)
3226 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3227 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3228 sections[nlist[i].n_sect-1].offset
3229 - sections[nlist[i].n_sect-1].addr
3230 + nlist[i].n_value);
3231 oc->symbols[curSymbol++] = nm;
3235 // insert local symbols into lochash
3236 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3238 if((nlist[i].n_type & N_TYPE) == N_SECT)
3240 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3241 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3242 sections[nlist[i].n_sect-1].offset
3243 - sections[nlist[i].n_sect-1].addr
3244 + nlist[i].n_value);
3249 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3250 commonCounter = (unsigned long)commonStorage;
3251 for(i=0;i<symLC->nsyms;i++)
3253 if((nlist[i].n_type & N_TYPE) == N_UNDF
3254 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3256 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3257 unsigned long sz = nlist[i].n_value;
3259 nlist[i].n_value = commonCounter;
3261 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3262 oc->symbols[curSymbol++] = nm;
3264 commonCounter += sz;
3270 static int ocResolve_MachO(ObjectCode* oc)
3272 char *image = (char*) oc->image;
3273 struct mach_header *header = (struct mach_header*) image;
3274 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3276 struct segment_command *segLC = NULL;
3277 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3278 struct symtab_command *symLC = NULL;
3279 struct dysymtab_command *dsymLC = NULL;
3280 struct nlist *nlist;
3281 unsigned long *indirectSyms;
3283 for(i=0;i<header->ncmds;i++)
3285 if(lc->cmd == LC_SEGMENT)
3286 segLC = (struct segment_command*) lc;
3287 else if(lc->cmd == LC_SYMTAB)
3288 symLC = (struct symtab_command*) lc;
3289 else if(lc->cmd == LC_DYSYMTAB)
3290 dsymLC = (struct dysymtab_command*) lc;
3291 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3294 sections = (struct section*) (segLC+1);
3295 nlist = (struct nlist*) (image + symLC->symoff);
3297 for(i=0;i<segLC->nsects;i++)
3299 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3300 la_ptrs = §ions[i];
3301 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3302 nl_ptrs = §ions[i];
3305 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3308 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3311 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3314 for(i=0;i<segLC->nsects;i++)
3316 if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
3320 /* Free the local symbol table; we won't need it again. */
3321 freeHashTable(oc->lochash, NULL);
3327 * The Mach-O object format uses leading underscores. But not everywhere.
3328 * There is a small number of runtime support functions defined in
3329 * libcc_dynamic.a whose name does not have a leading underscore.
3330 * As a consequence, we can't get their address from C code.
3331 * We have to use inline assembler just to take the address of a function.
3335 static void machoInitSymbolsWithoutUnderscore()
3341 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3342 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3344 RTS_MACHO_NOUNDERLINE_SYMBOLS