1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.119 2003/04/29 21:37:31 wolfgang Exp $
4 * (c) The GHC Team, 2000-2003
8 * ---------------------------------------------------------------------------*/
11 #include "PosixSource.h"
18 #include "LinkerInternals.h"
20 #include "StoragePriv.h"
23 #ifdef HAVE_SYS_TYPES_H
24 #include <sys/types.h>
30 #ifdef HAVE_SYS_STAT_H
34 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
35 #include <HaskellSupport/dlfcn.h>
36 #elif defined(HAVE_DLFCN_H)
40 #if defined(cygwin32_TARGET_OS)
45 #ifdef HAVE_SYS_TIME_H
49 #include <sys/fcntl.h>
50 #include <sys/termios.h>
51 #include <sys/utime.h>
52 #include <sys/utsname.h>
56 #if defined(ia64_TARGET_ARCH)
62 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS)
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 /* These are statically linked from the mingw libraries into the ghc
218 executable, so we have to employ this hack. */
219 #define RTS_MINGW_ONLY_SYMBOLS \
220 SymX(asyncReadzh_fast) \
221 SymX(asyncWritezh_fast) \
233 SymX(getservbyname) \
234 SymX(getservbyport) \
235 SymX(getprotobynumber) \
236 SymX(getprotobyname) \
237 SymX(gethostbyname) \
238 SymX(gethostbyaddr) \
273 Sym(_imp___timezone) \
285 # define MAIN_CAP_SYM SymX(MainCapability)
287 # define MAIN_CAP_SYM
290 #define RTS_SYMBOLS \
294 SymX(stg_enter_info) \
295 SymX(stg_enter_ret) \
296 SymX(stg_gc_void_info) \
297 SymX(__stg_gc_enter_1) \
298 SymX(stg_gc_noregs) \
299 SymX(stg_gc_unpt_r1_info) \
300 SymX(stg_gc_unpt_r1) \
301 SymX(stg_gc_unbx_r1_info) \
302 SymX(stg_gc_unbx_r1) \
303 SymX(stg_gc_f1_info) \
305 SymX(stg_gc_d1_info) \
307 SymX(stg_gc_l1_info) \
310 SymX(stg_gc_fun_info) \
311 SymX(stg_gc_fun_ret) \
313 SymX(stg_gc_gen_info) \
314 SymX(stg_gc_gen_hp) \
316 SymX(stg_gen_yield) \
317 SymX(stg_yield_noregs) \
318 SymX(stg_yield_to_interpreter) \
319 SymX(stg_gen_block) \
320 SymX(stg_block_noregs) \
322 SymX(stg_block_takemvar) \
323 SymX(stg_block_putmvar) \
324 SymX(stg_seq_frame_info) \
327 SymX(MallocFailHook) \
329 SymX(OutOfHeapHook) \
330 SymX(PatErrorHdrHook) \
331 SymX(PostTraceHook) \
333 SymX(StackOverflowHook) \
334 SymX(__encodeDouble) \
335 SymX(__encodeFloat) \
338 SymX(__gmpz_cmp_si) \
339 SymX(__gmpz_cmp_ui) \
340 SymX(__gmpz_get_si) \
341 SymX(__gmpz_get_ui) \
342 SymX(__int_encodeDouble) \
343 SymX(__int_encodeFloat) \
344 SymX(andIntegerzh_fast) \
345 SymX(blockAsyncExceptionszh_fast) \
348 SymX(complementIntegerzh_fast) \
349 SymX(cmpIntegerzh_fast) \
350 SymX(cmpIntegerIntzh_fast) \
351 SymX(createAdjustor) \
352 SymX(decodeDoublezh_fast) \
353 SymX(decodeFloatzh_fast) \
356 SymX(deRefWeakzh_fast) \
357 SymX(deRefStablePtrzh_fast) \
358 SymX(divExactIntegerzh_fast) \
359 SymX(divModIntegerzh_fast) \
361 SymX(forkProcesszh_fast) \
362 SymX(freeHaskellFunctionPtr) \
363 SymX(freeStablePtr) \
364 SymX(gcdIntegerzh_fast) \
365 SymX(gcdIntegerIntzh_fast) \
366 SymX(gcdIntzh_fast) \
369 SymX(int2Integerzh_fast) \
370 SymX(integer2Intzh_fast) \
371 SymX(integer2Wordzh_fast) \
372 SymX(isDoubleDenormalized) \
373 SymX(isDoubleInfinite) \
375 SymX(isDoubleNegativeZero) \
376 SymX(isEmptyMVarzh_fast) \
377 SymX(isFloatDenormalized) \
378 SymX(isFloatInfinite) \
380 SymX(isFloatNegativeZero) \
381 SymX(killThreadzh_fast) \
382 SymX(makeStablePtrzh_fast) \
383 SymX(minusIntegerzh_fast) \
384 SymX(mkApUpd0zh_fast) \
385 SymX(myThreadIdzh_fast) \
386 SymX(labelThreadzh_fast) \
387 SymX(newArrayzh_fast) \
388 SymX(newBCOzh_fast) \
389 SymX(newByteArrayzh_fast) \
390 SymX_redirect(newCAF, newDynCAF) \
391 SymX(newMVarzh_fast) \
392 SymX(newMutVarzh_fast) \
393 SymX(atomicModifyMutVarzh_fast) \
394 SymX(newPinnedByteArrayzh_fast) \
395 SymX(orIntegerzh_fast) \
397 SymX(plusIntegerzh_fast) \
400 SymX(putMVarzh_fast) \
401 SymX(quotIntegerzh_fast) \
402 SymX(quotRemIntegerzh_fast) \
404 SymX(remIntegerzh_fast) \
405 SymX(resetNonBlockingFd) \
408 SymX(rts_checkSchedStatus) \
411 SymX(rts_evalLazyIO) \
415 SymX(rts_getDouble) \
420 SymX(rts_getFunPtr) \
421 SymX(rts_getStablePtr) \
422 SymX(rts_getThreadId) \
424 SymX(rts_getWord32) \
437 SymX(rts_mkStablePtr) \
447 SymX(startupHaskell) \
448 SymX(shutdownHaskell) \
449 SymX(shutdownHaskellAndExit) \
450 SymX(stable_ptr_table) \
451 SymX(stackOverflow) \
452 SymX(stg_CAF_BLACKHOLE_info) \
453 SymX(stg_CHARLIKE_closure) \
454 SymX(stg_EMPTY_MVAR_info) \
455 SymX(stg_IND_STATIC_info) \
456 SymX(stg_INTLIKE_closure) \
457 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
458 SymX(stg_WEAK_info) \
459 SymX(stg_ap_v_info) \
460 SymX(stg_ap_f_info) \
461 SymX(stg_ap_d_info) \
462 SymX(stg_ap_l_info) \
463 SymX(stg_ap_n_info) \
464 SymX(stg_ap_p_info) \
465 SymX(stg_ap_pv_info) \
466 SymX(stg_ap_pp_info) \
467 SymX(stg_ap_ppv_info) \
468 SymX(stg_ap_ppp_info) \
469 SymX(stg_ap_pppp_info) \
470 SymX(stg_ap_ppppp_info) \
471 SymX(stg_ap_pppppp_info) \
472 SymX(stg_ap_ppppppp_info) \
480 SymX(stg_ap_pv_ret) \
481 SymX(stg_ap_pp_ret) \
482 SymX(stg_ap_ppv_ret) \
483 SymX(stg_ap_ppp_ret) \
484 SymX(stg_ap_pppp_ret) \
485 SymX(stg_ap_ppppp_ret) \
486 SymX(stg_ap_pppppp_ret) \
487 SymX(stg_ap_ppppppp_ret) \
488 SymX(stg_ap_1_upd_info) \
489 SymX(stg_ap_2_upd_info) \
490 SymX(stg_ap_3_upd_info) \
491 SymX(stg_ap_4_upd_info) \
492 SymX(stg_ap_5_upd_info) \
493 SymX(stg_ap_6_upd_info) \
494 SymX(stg_ap_7_upd_info) \
495 SymX(stg_ap_8_upd_info) \
497 SymX(stg_sel_0_upd_info) \
498 SymX(stg_sel_10_upd_info) \
499 SymX(stg_sel_11_upd_info) \
500 SymX(stg_sel_12_upd_info) \
501 SymX(stg_sel_13_upd_info) \
502 SymX(stg_sel_14_upd_info) \
503 SymX(stg_sel_15_upd_info) \
504 SymX(stg_sel_1_upd_info) \
505 SymX(stg_sel_2_upd_info) \
506 SymX(stg_sel_3_upd_info) \
507 SymX(stg_sel_4_upd_info) \
508 SymX(stg_sel_5_upd_info) \
509 SymX(stg_sel_6_upd_info) \
510 SymX(stg_sel_7_upd_info) \
511 SymX(stg_sel_8_upd_info) \
512 SymX(stg_sel_9_upd_info) \
513 SymX(stg_upd_frame_info) \
514 SymX(suspendThread) \
515 SymX(takeMVarzh_fast) \
516 SymX(timesIntegerzh_fast) \
517 SymX(tryPutMVarzh_fast) \
518 SymX(tryTakeMVarzh_fast) \
519 SymX(unblockAsyncExceptionszh_fast) \
520 SymX(unsafeThawArrayzh_fast) \
521 SymX(waitReadzh_fast) \
522 SymX(waitWritezh_fast) \
523 SymX(word2Integerzh_fast) \
524 SymX(xorIntegerzh_fast) \
527 #ifdef SUPPORT_LONG_LONGS
528 #define RTS_LONG_LONG_SYMS \
529 SymX(int64ToIntegerzh_fast) \
530 SymX(word64ToIntegerzh_fast)
532 #define RTS_LONG_LONG_SYMS /* nothing */
535 // 64-bit support functions in libgcc.a
536 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
537 #define RTS_LIBGCC_SYMBOLS \
547 #define RTS_LIBGCC_SYMBOLS
550 #ifdef ia64_TARGET_ARCH
551 /* force these symbols to be present */
552 #define RTS_EXTRA_SYMBOLS \
555 #define RTS_EXTRA_SYMBOLS /* nothing */
558 #ifdef darwin_TARGET_OS
559 // Symbols that don't have a leading underscore
560 // on Mac OS X. They have to receive special treatment,
561 // see machoInitSymbolsWithoutUnderscore()
562 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
567 /* entirely bogus claims about types of these symbols */
568 #define Sym(vvv) extern void (vvv);
569 #define SymX(vvv) /**/
570 #define SymX_redirect(vvv,xxx) /**/
574 RTS_POSIX_ONLY_SYMBOLS
575 RTS_MINGW_ONLY_SYMBOLS
576 RTS_CYGWIN_ONLY_SYMBOLS
582 #ifdef LEADING_UNDERSCORE
583 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
585 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
588 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
590 #define SymX(vvv) Sym(vvv)
592 // SymX_redirect allows us to redirect references to one symbol to
593 // another symbol. See newCAF/newDynCAF for an example.
594 #define SymX_redirect(vvv,xxx) \
595 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
598 static RtsSymbolVal rtsSyms[] = {
602 RTS_POSIX_ONLY_SYMBOLS
603 RTS_MINGW_ONLY_SYMBOLS
604 RTS_CYGWIN_ONLY_SYMBOLS
606 { 0, 0 } /* sentinel */
609 /* -----------------------------------------------------------------------------
610 * Insert symbols into hash tables, checking for duplicates.
612 static void ghciInsertStrHashTable ( char* obj_name,
618 if (lookupHashTable(table, (StgWord)key) == NULL)
620 insertStrHashTable(table, (StgWord)key, data);
625 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
627 "whilst processing object file\n"
629 "This could be caused by:\n"
630 " * Loading two different object files which export the same symbol\n"
631 " * Specifying the same object file twice on the GHCi command line\n"
632 " * An incorrect `package.conf' entry, causing some object to be\n"
634 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
643 /* -----------------------------------------------------------------------------
644 * initialize the object linker
648 static int linker_init_done = 0 ;
650 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
651 static void *dl_prog_handle;
659 /* Make initLinker idempotent, so we can call it
660 before evey relevant operation; that means we
661 don't need to initialise the linker separately */
662 if (linker_init_done == 1) { return; } else {
663 linker_init_done = 1;
666 symhash = allocStrHashTable();
668 /* populate the symbol table with stuff from the RTS */
669 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
670 ghciInsertStrHashTable("(GHCi built-in symbols)",
671 symhash, sym->lbl, sym->addr);
673 # if defined(OBJFORMAT_MACHO)
674 machoInitSymbolsWithoutUnderscore();
677 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
678 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
682 /* -----------------------------------------------------------------------------
683 * Loading DLL or .so dynamic libraries
684 * -----------------------------------------------------------------------------
686 * Add a DLL from which symbols may be found. In the ELF case, just
687 * do RTLD_GLOBAL-style add, so no further messing around needs to
688 * happen in order that symbols in the loaded .so are findable --
689 * lookupSymbol() will subsequently see them by dlsym on the program's
690 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
692 * In the PEi386 case, open the DLLs and put handles to them in a
693 * linked list. When looking for a symbol, try all handles in the
694 * list. This means that we need to load even DLLs that are guaranteed
695 * to be in the ghc.exe image already, just so we can get a handle
696 * to give to loadSymbol, so that we can find the symbols. For such
697 * libraries, the LoadLibrary call should be a no-op except for returning
702 #if defined(OBJFORMAT_PEi386)
703 /* A record for storing handles into DLLs. */
708 struct _OpenedDLL* next;
713 /* A list thereof. */
714 static OpenedDLL* opened_dlls = NULL;
718 addDLL( char *dll_name )
720 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
721 /* ------------------- ELF DLL loader ------------------- */
727 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
729 /* dlopen failed; return a ptr to the error msg. */
731 if (errmsg == NULL) errmsg = "addDLL: unknown error";
738 # elif defined(OBJFORMAT_PEi386)
739 /* ------------------- Win32 DLL loader ------------------- */
747 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
749 /* See if we've already got it, and ignore if so. */
750 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
751 if (0 == strcmp(o_dll->name, dll_name))
755 /* The file name has no suffix (yet) so that we can try
756 both foo.dll and foo.drv
758 The documentation for LoadLibrary says:
759 If no file name extension is specified in the lpFileName
760 parameter, the default library extension .dll is
761 appended. However, the file name string can include a trailing
762 point character (.) to indicate that the module name has no
765 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
766 sprintf(buf, "%s.DLL", dll_name);
767 instance = LoadLibrary(buf);
768 if (instance == NULL) {
769 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
770 instance = LoadLibrary(buf);
771 if (instance == NULL) {
774 /* LoadLibrary failed; return a ptr to the error msg. */
775 return "addDLL: unknown error";
780 /* Add this DLL to the list of DLLs in which to search for symbols. */
781 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
782 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
783 strcpy(o_dll->name, dll_name);
784 o_dll->instance = instance;
785 o_dll->next = opened_dlls;
790 barf("addDLL: not implemented on this platform");
794 /* -----------------------------------------------------------------------------
795 * lookup a symbol in the hash table
798 lookupSymbol( char *lbl )
802 ASSERT(symhash != NULL);
803 val = lookupStrHashTable(symhash, lbl);
806 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
807 return dlsym(dl_prog_handle, lbl);
808 # elif defined(OBJFORMAT_PEi386)
811 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
812 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
814 /* HACK: if the name has an initial underscore, try stripping
815 it off & look that up first. I've yet to verify whether there's
816 a Rule that governs whether an initial '_' *should always* be
817 stripped off when mapping from import lib name to the DLL name.
819 sym = GetProcAddress(o_dll->instance, (lbl+1));
821 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
825 sym = GetProcAddress(o_dll->instance, lbl);
827 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
842 __attribute((unused))
844 lookupLocalSymbol( ObjectCode* oc, char *lbl )
848 val = lookupStrHashTable(oc->lochash, lbl);
858 /* -----------------------------------------------------------------------------
859 * Debugging aid: look in GHCi's object symbol tables for symbols
860 * within DELTA bytes of the specified address, and show their names.
863 void ghci_enquire ( char* addr );
865 void ghci_enquire ( char* addr )
870 const int DELTA = 64;
875 for (oc = objects; oc; oc = oc->next) {
876 for (i = 0; i < oc->n_symbols; i++) {
877 sym = oc->symbols[i];
878 if (sym == NULL) continue;
879 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
881 if (oc->lochash != NULL) {
882 a = lookupStrHashTable(oc->lochash, sym);
885 a = lookupStrHashTable(symhash, sym);
888 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
890 else if (addr-DELTA <= a && a <= addr+DELTA) {
891 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
898 #ifdef ia64_TARGET_ARCH
899 static unsigned int PLTSize(void);
902 /* -----------------------------------------------------------------------------
903 * Load an obj (populate the global symbol table, but don't resolve yet)
905 * Returns: 1 if ok, 0 on error.
908 loadObj( char *path )
922 /* fprintf(stderr, "loadObj %s\n", path ); */
924 /* Check that we haven't already loaded this object. Don't give up
925 at this stage; ocGetNames_* will barf later. */
929 for (o = objects; o; o = o->next) {
930 if (0 == strcmp(o->fileName, path))
936 "GHCi runtime linker: warning: looks like you're trying to load the\n"
937 "same object file twice:\n"
939 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
945 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
947 # if defined(OBJFORMAT_ELF)
948 oc->formatName = "ELF";
949 # elif defined(OBJFORMAT_PEi386)
950 oc->formatName = "PEi386";
951 # elif defined(OBJFORMAT_MACHO)
952 oc->formatName = "Mach-O";
955 barf("loadObj: not implemented on this platform");
959 if (r == -1) { return 0; }
961 /* sigh, strdup() isn't a POSIX function, so do it the long way */
962 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
963 strcpy(oc->fileName, path);
965 oc->fileSize = st.st_size;
968 oc->lochash = allocStrHashTable();
969 oc->proddables = NULL;
971 /* chain it onto the list of objects */
976 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
978 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
980 fd = open(path, O_RDONLY);
982 barf("loadObj: can't open `%s'", path);
984 pagesize = getpagesize();
986 #ifdef ia64_TARGET_ARCH
987 /* The PLT needs to be right before the object */
988 n = ROUND_UP(PLTSize(), pagesize);
989 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
990 if (oc->plt == MAP_FAILED)
991 barf("loadObj: can't allocate PLT");
994 map_addr = oc->plt + n;
997 n = ROUND_UP(oc->fileSize, pagesize);
998 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
999 if (oc->image == MAP_FAILED)
1000 barf("loadObj: can't map `%s'", path);
1004 #else /* !USE_MMAP */
1006 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1008 /* load the image into memory */
1009 f = fopen(path, "rb");
1011 barf("loadObj: can't read `%s'", path);
1013 n = fread ( oc->image, 1, oc->fileSize, f );
1014 if (n != oc->fileSize)
1015 barf("loadObj: error whilst reading `%s'", path);
1019 #endif /* USE_MMAP */
1021 /* verify the in-memory image */
1022 # if defined(OBJFORMAT_ELF)
1023 r = ocVerifyImage_ELF ( oc );
1024 # elif defined(OBJFORMAT_PEi386)
1025 r = ocVerifyImage_PEi386 ( oc );
1026 # elif defined(OBJFORMAT_MACHO)
1027 r = ocVerifyImage_MachO ( oc );
1029 barf("loadObj: no verify method");
1031 if (!r) { return r; }
1033 /* build the symbol list for this image */
1034 # if defined(OBJFORMAT_ELF)
1035 r = ocGetNames_ELF ( oc );
1036 # elif defined(OBJFORMAT_PEi386)
1037 r = ocGetNames_PEi386 ( oc );
1038 # elif defined(OBJFORMAT_MACHO)
1039 r = ocGetNames_MachO ( oc );
1041 barf("loadObj: no getNames method");
1043 if (!r) { return r; }
1045 /* loaded, but not resolved yet */
1046 oc->status = OBJECT_LOADED;
1051 /* -----------------------------------------------------------------------------
1052 * resolve all the currently unlinked objects in memory
1054 * Returns: 1 if ok, 0 on error.
1064 for (oc = objects; oc; oc = oc->next) {
1065 if (oc->status != OBJECT_RESOLVED) {
1066 # if defined(OBJFORMAT_ELF)
1067 r = ocResolve_ELF ( oc );
1068 # elif defined(OBJFORMAT_PEi386)
1069 r = ocResolve_PEi386 ( oc );
1070 # elif defined(OBJFORMAT_MACHO)
1071 r = ocResolve_MachO ( oc );
1073 barf("resolveObjs: not implemented on this platform");
1075 if (!r) { return r; }
1076 oc->status = OBJECT_RESOLVED;
1082 /* -----------------------------------------------------------------------------
1083 * delete an object from the pool
1086 unloadObj( char *path )
1088 ObjectCode *oc, *prev;
1090 ASSERT(symhash != NULL);
1091 ASSERT(objects != NULL);
1096 for (oc = objects; oc; prev = oc, oc = oc->next) {
1097 if (!strcmp(oc->fileName,path)) {
1099 /* Remove all the mappings for the symbols within this
1104 for (i = 0; i < oc->n_symbols; i++) {
1105 if (oc->symbols[i] != NULL) {
1106 removeStrHashTable(symhash, oc->symbols[i], NULL);
1114 prev->next = oc->next;
1117 /* We're going to leave this in place, in case there are
1118 any pointers from the heap into it: */
1119 /* stgFree(oc->image); */
1120 stgFree(oc->fileName);
1121 stgFree(oc->symbols);
1122 stgFree(oc->sections);
1123 /* The local hash table should have been freed at the end
1124 of the ocResolve_ call on it. */
1125 ASSERT(oc->lochash == NULL);
1131 belch("unloadObj: can't find `%s' to unload", path);
1135 /* -----------------------------------------------------------------------------
1136 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1137 * which may be prodded during relocation, and abort if we try and write
1138 * outside any of these.
1140 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1143 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1144 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1148 pb->next = oc->proddables;
1149 oc->proddables = pb;
1152 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1155 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1156 char* s = (char*)(pb->start);
1157 char* e = s + pb->size - 1;
1158 char* a = (char*)addr;
1159 /* Assumes that the biggest fixup involves a 4-byte write. This
1160 probably needs to be changed to 8 (ie, +7) on 64-bit
1162 if (a >= s && (a+3) <= e) return;
1164 barf("checkProddableBlock: invalid fixup in runtime linker");
1167 /* -----------------------------------------------------------------------------
1168 * Section management.
1170 static void addSection ( ObjectCode* oc, SectionKind kind,
1171 void* start, void* end )
1173 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1177 s->next = oc->sections;
1180 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1181 start, ((char*)end)-1, end - start + 1, kind );
1187 /* --------------------------------------------------------------------------
1188 * PEi386 specifics (Win32 targets)
1189 * ------------------------------------------------------------------------*/
1191 /* The information for this linker comes from
1192 Microsoft Portable Executable
1193 and Common Object File Format Specification
1194 revision 5.1 January 1998
1195 which SimonM says comes from the MS Developer Network CDs.
1197 It can be found there (on older CDs), but can also be found
1200 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1202 (this is Rev 6.0 from February 1999).
1204 Things move, so if that fails, try searching for it via
1206 http://www.google.com/search?q=PE+COFF+specification
1208 The ultimate reference for the PE format is the Winnt.h
1209 header file that comes with the Platform SDKs; as always,
1210 implementations will drift wrt their documentation.
1212 A good background article on the PE format is Matt Pietrek's
1213 March 1994 article in Microsoft System Journal (MSJ)
1214 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1215 Win32 Portable Executable File Format." The info in there
1216 has recently been updated in a two part article in
1217 MSDN magazine, issues Feb and March 2002,
1218 "Inside Windows: An In-Depth Look into the Win32 Portable
1219 Executable File Format"
1221 John Levine's book "Linkers and Loaders" contains useful
1226 #if defined(OBJFORMAT_PEi386)
1230 typedef unsigned char UChar;
1231 typedef unsigned short UInt16;
1232 typedef unsigned int UInt32;
1239 UInt16 NumberOfSections;
1240 UInt32 TimeDateStamp;
1241 UInt32 PointerToSymbolTable;
1242 UInt32 NumberOfSymbols;
1243 UInt16 SizeOfOptionalHeader;
1244 UInt16 Characteristics;
1248 #define sizeof_COFF_header 20
1255 UInt32 VirtualAddress;
1256 UInt32 SizeOfRawData;
1257 UInt32 PointerToRawData;
1258 UInt32 PointerToRelocations;
1259 UInt32 PointerToLinenumbers;
1260 UInt16 NumberOfRelocations;
1261 UInt16 NumberOfLineNumbers;
1262 UInt32 Characteristics;
1266 #define sizeof_COFF_section 40
1273 UInt16 SectionNumber;
1276 UChar NumberOfAuxSymbols;
1280 #define sizeof_COFF_symbol 18
1285 UInt32 VirtualAddress;
1286 UInt32 SymbolTableIndex;
1291 #define sizeof_COFF_reloc 10
1294 /* From PE spec doc, section 3.3.2 */
1295 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1296 windows.h -- for the same purpose, but I want to know what I'm
1298 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1299 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1300 #define MYIMAGE_FILE_DLL 0x2000
1301 #define MYIMAGE_FILE_SYSTEM 0x1000
1302 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1303 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1304 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1306 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1307 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1308 #define MYIMAGE_SYM_CLASS_STATIC 3
1309 #define MYIMAGE_SYM_UNDEFINED 0
1311 /* From PE spec doc, section 4.1 */
1312 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1313 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1314 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1316 /* From PE spec doc, section 5.2.1 */
1317 #define MYIMAGE_REL_I386_DIR32 0x0006
1318 #define MYIMAGE_REL_I386_REL32 0x0014
1321 /* We use myindex to calculate array addresses, rather than
1322 simply doing the normal subscript thing. That's because
1323 some of the above structs have sizes which are not
1324 a whole number of words. GCC rounds their sizes up to a
1325 whole number of words, which means that the address calcs
1326 arising from using normal C indexing or pointer arithmetic
1327 are just plain wrong. Sigh.
1330 myindex ( int scale, void* base, int index )
1333 ((UChar*)base) + scale * index;
1338 printName ( UChar* name, UChar* strtab )
1340 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1341 UInt32 strtab_offset = * (UInt32*)(name+4);
1342 fprintf ( stderr, "%s", strtab + strtab_offset );
1345 for (i = 0; i < 8; i++) {
1346 if (name[i] == 0) break;
1347 fprintf ( stderr, "%c", name[i] );
1354 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1356 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1357 UInt32 strtab_offset = * (UInt32*)(name+4);
1358 strncpy ( dst, strtab+strtab_offset, dstSize );
1364 if (name[i] == 0) break;
1374 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1377 /* If the string is longer than 8 bytes, look in the
1378 string table for it -- this will be correctly zero terminated.
1380 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1381 UInt32 strtab_offset = * (UInt32*)(name+4);
1382 return ((UChar*)strtab) + strtab_offset;
1384 /* Otherwise, if shorter than 8 bytes, return the original,
1385 which by defn is correctly terminated.
1387 if (name[7]==0) return name;
1388 /* The annoying case: 8 bytes. Copy into a temporary
1389 (which is never freed ...)
1391 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1393 strncpy(newstr,name,8);
1399 /* Just compares the short names (first 8 chars) */
1400 static COFF_section *
1401 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1405 = (COFF_header*)(oc->image);
1406 COFF_section* sectab
1408 ((UChar*)(oc->image))
1409 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1411 for (i = 0; i < hdr->NumberOfSections; i++) {
1414 COFF_section* section_i
1416 myindex ( sizeof_COFF_section, sectab, i );
1417 n1 = (UChar*) &(section_i->Name);
1419 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1420 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1421 n1[6]==n2[6] && n1[7]==n2[7])
1430 zapTrailingAtSign ( UChar* sym )
1432 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1434 if (sym[0] == 0) return;
1436 while (sym[i] != 0) i++;
1439 while (j > 0 && my_isdigit(sym[j])) j--;
1440 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1446 ocVerifyImage_PEi386 ( ObjectCode* oc )
1451 COFF_section* sectab;
1452 COFF_symbol* symtab;
1454 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1455 hdr = (COFF_header*)(oc->image);
1456 sectab = (COFF_section*) (
1457 ((UChar*)(oc->image))
1458 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1460 symtab = (COFF_symbol*) (
1461 ((UChar*)(oc->image))
1462 + hdr->PointerToSymbolTable
1464 strtab = ((UChar*)symtab)
1465 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1467 if (hdr->Machine != 0x14c) {
1468 belch("Not x86 PEi386");
1471 if (hdr->SizeOfOptionalHeader != 0) {
1472 belch("PEi386 with nonempty optional header");
1475 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1476 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1477 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1478 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1479 belch("Not a PEi386 object file");
1482 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1483 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1484 belch("Invalid PEi386 word size or endiannness: %d",
1485 (int)(hdr->Characteristics));
1488 /* If the string table size is way crazy, this might indicate that
1489 there are more than 64k relocations, despite claims to the
1490 contrary. Hence this test. */
1491 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1493 if ( (*(UInt32*)strtab) > 600000 ) {
1494 /* Note that 600k has no special significance other than being
1495 big enough to handle the almost-2MB-sized lumps that
1496 constitute HSwin32*.o. */
1497 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1502 /* No further verification after this point; only debug printing. */
1504 IF_DEBUG(linker, i=1);
1505 if (i == 0) return 1;
1508 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1510 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1512 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1514 fprintf ( stderr, "\n" );
1516 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1518 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1520 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1522 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1524 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1526 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1528 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1530 /* Print the section table. */
1531 fprintf ( stderr, "\n" );
1532 for (i = 0; i < hdr->NumberOfSections; i++) {
1534 COFF_section* sectab_i
1536 myindex ( sizeof_COFF_section, sectab, i );
1543 printName ( sectab_i->Name, strtab );
1553 sectab_i->VirtualSize,
1554 sectab_i->VirtualAddress,
1555 sectab_i->SizeOfRawData,
1556 sectab_i->PointerToRawData,
1557 sectab_i->NumberOfRelocations,
1558 sectab_i->PointerToRelocations,
1559 sectab_i->PointerToRawData
1561 reltab = (COFF_reloc*) (
1562 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1565 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1566 /* If the relocation field (a short) has overflowed, the
1567 * real count can be found in the first reloc entry.
1569 * See Section 4.1 (last para) of the PE spec (rev6.0).
1571 COFF_reloc* rel = (COFF_reloc*)
1572 myindex ( sizeof_COFF_reloc, reltab, 0 );
1573 noRelocs = rel->VirtualAddress;
1576 noRelocs = sectab_i->NumberOfRelocations;
1580 for (; j < noRelocs; j++) {
1582 COFF_reloc* rel = (COFF_reloc*)
1583 myindex ( sizeof_COFF_reloc, reltab, j );
1585 " type 0x%-4x vaddr 0x%-8x name `",
1587 rel->VirtualAddress );
1588 sym = (COFF_symbol*)
1589 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1590 /* Hmm..mysterious looking offset - what's it for? SOF */
1591 printName ( sym->Name, strtab -10 );
1592 fprintf ( stderr, "'\n" );
1595 fprintf ( stderr, "\n" );
1597 fprintf ( stderr, "\n" );
1598 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1599 fprintf ( stderr, "---START of string table---\n");
1600 for (i = 4; i < *(Int32*)strtab; i++) {
1602 fprintf ( stderr, "\n"); else
1603 fprintf( stderr, "%c", strtab[i] );
1605 fprintf ( stderr, "--- END of string table---\n");
1607 fprintf ( stderr, "\n" );
1610 COFF_symbol* symtab_i;
1611 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1612 symtab_i = (COFF_symbol*)
1613 myindex ( sizeof_COFF_symbol, symtab, i );
1619 printName ( symtab_i->Name, strtab );
1628 (Int32)(symtab_i->SectionNumber),
1629 (UInt32)symtab_i->Type,
1630 (UInt32)symtab_i->StorageClass,
1631 (UInt32)symtab_i->NumberOfAuxSymbols
1633 i += symtab_i->NumberOfAuxSymbols;
1637 fprintf ( stderr, "\n" );
1643 ocGetNames_PEi386 ( ObjectCode* oc )
1646 COFF_section* sectab;
1647 COFF_symbol* symtab;
1654 hdr = (COFF_header*)(oc->image);
1655 sectab = (COFF_section*) (
1656 ((UChar*)(oc->image))
1657 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1659 symtab = (COFF_symbol*) (
1660 ((UChar*)(oc->image))
1661 + hdr->PointerToSymbolTable
1663 strtab = ((UChar*)(oc->image))
1664 + hdr->PointerToSymbolTable
1665 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1667 /* Allocate space for any (local, anonymous) .bss sections. */
1669 for (i = 0; i < hdr->NumberOfSections; i++) {
1671 COFF_section* sectab_i
1673 myindex ( sizeof_COFF_section, sectab, i );
1674 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1675 if (sectab_i->VirtualSize == 0) continue;
1676 /* This is a non-empty .bss section. Allocate zeroed space for
1677 it, and set its PointerToRawData field such that oc->image +
1678 PointerToRawData == addr_of_zeroed_space. */
1679 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1680 "ocGetNames_PEi386(anonymous bss)");
1681 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1682 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1683 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1686 /* Copy section information into the ObjectCode. */
1688 for (i = 0; i < hdr->NumberOfSections; i++) {
1694 = SECTIONKIND_OTHER;
1695 COFF_section* sectab_i
1697 myindex ( sizeof_COFF_section, sectab, i );
1698 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1701 /* I'm sure this is the Right Way to do it. However, the
1702 alternative of testing the sectab_i->Name field seems to
1703 work ok with Cygwin.
1705 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1706 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1707 kind = SECTIONKIND_CODE_OR_RODATA;
1710 if (0==strcmp(".text",sectab_i->Name) ||
1711 0==strcmp(".rodata",sectab_i->Name))
1712 kind = SECTIONKIND_CODE_OR_RODATA;
1713 if (0==strcmp(".data",sectab_i->Name) ||
1714 0==strcmp(".bss",sectab_i->Name))
1715 kind = SECTIONKIND_RWDATA;
1717 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1718 sz = sectab_i->SizeOfRawData;
1719 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1721 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1722 end = start + sz - 1;
1724 if (kind == SECTIONKIND_OTHER
1725 /* Ignore sections called which contain stabs debugging
1727 && 0 != strcmp(".stab", sectab_i->Name)
1728 && 0 != strcmp(".stabstr", sectab_i->Name)
1730 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1734 if (kind != SECTIONKIND_OTHER && end >= start) {
1735 addSection(oc, kind, start, end);
1736 addProddableBlock(oc, start, end - start + 1);
1740 /* Copy exported symbols into the ObjectCode. */
1742 oc->n_symbols = hdr->NumberOfSymbols;
1743 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1744 "ocGetNames_PEi386(oc->symbols)");
1745 /* Call me paranoid; I don't care. */
1746 for (i = 0; i < oc->n_symbols; i++)
1747 oc->symbols[i] = NULL;
1751 COFF_symbol* symtab_i;
1752 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1753 symtab_i = (COFF_symbol*)
1754 myindex ( sizeof_COFF_symbol, symtab, i );
1758 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1759 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1760 /* This symbol is global and defined, viz, exported */
1761 /* for MYIMAGE_SYMCLASS_EXTERNAL
1762 && !MYIMAGE_SYM_UNDEFINED,
1763 the address of the symbol is:
1764 address of relevant section + offset in section
1766 COFF_section* sectabent
1767 = (COFF_section*) myindex ( sizeof_COFF_section,
1769 symtab_i->SectionNumber-1 );
1770 addr = ((UChar*)(oc->image))
1771 + (sectabent->PointerToRawData
1775 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1776 && symtab_i->Value > 0) {
1777 /* This symbol isn't in any section at all, ie, global bss.
1778 Allocate zeroed space for it. */
1779 addr = stgCallocBytes(1, symtab_i->Value,
1780 "ocGetNames_PEi386(non-anonymous bss)");
1781 addSection(oc, SECTIONKIND_RWDATA, addr,
1782 ((UChar*)addr) + symtab_i->Value - 1);
1783 addProddableBlock(oc, addr, symtab_i->Value);
1784 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1787 if (addr != NULL ) {
1788 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1789 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1790 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1791 ASSERT(i >= 0 && i < oc->n_symbols);
1792 /* cstring_from_COFF_symbol_name always succeeds. */
1793 oc->symbols[i] = sname;
1794 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1798 "IGNORING symbol %d\n"
1802 printName ( symtab_i->Name, strtab );
1811 (Int32)(symtab_i->SectionNumber),
1812 (UInt32)symtab_i->Type,
1813 (UInt32)symtab_i->StorageClass,
1814 (UInt32)symtab_i->NumberOfAuxSymbols
1819 i += symtab_i->NumberOfAuxSymbols;
1828 ocResolve_PEi386 ( ObjectCode* oc )
1831 COFF_section* sectab;
1832 COFF_symbol* symtab;
1842 /* ToDo: should be variable-sized? But is at least safe in the
1843 sense of buffer-overrun-proof. */
1845 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1847 hdr = (COFF_header*)(oc->image);
1848 sectab = (COFF_section*) (
1849 ((UChar*)(oc->image))
1850 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1852 symtab = (COFF_symbol*) (
1853 ((UChar*)(oc->image))
1854 + hdr->PointerToSymbolTable
1856 strtab = ((UChar*)(oc->image))
1857 + hdr->PointerToSymbolTable
1858 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1860 for (i = 0; i < hdr->NumberOfSections; i++) {
1861 COFF_section* sectab_i
1863 myindex ( sizeof_COFF_section, sectab, i );
1866 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1869 /* Ignore sections called which contain stabs debugging
1871 if (0 == strcmp(".stab", sectab_i->Name)
1872 || 0 == strcmp(".stabstr", sectab_i->Name))
1875 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1876 /* If the relocation field (a short) has overflowed, the
1877 * real count can be found in the first reloc entry.
1879 * See Section 4.1 (last para) of the PE spec (rev6.0).
1881 COFF_reloc* rel = (COFF_reloc*)
1882 myindex ( sizeof_COFF_reloc, reltab, 0 );
1883 noRelocs = rel->VirtualAddress;
1884 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1887 noRelocs = sectab_i->NumberOfRelocations;
1892 for (; j < noRelocs; j++) {
1894 COFF_reloc* reltab_j
1896 myindex ( sizeof_COFF_reloc, reltab, j );
1898 /* the location to patch */
1900 ((UChar*)(oc->image))
1901 + (sectab_i->PointerToRawData
1902 + reltab_j->VirtualAddress
1903 - sectab_i->VirtualAddress )
1905 /* the existing contents of pP */
1907 /* the symbol to connect to */
1908 sym = (COFF_symbol*)
1909 myindex ( sizeof_COFF_symbol,
1910 symtab, reltab_j->SymbolTableIndex );
1913 "reloc sec %2d num %3d: type 0x%-4x "
1914 "vaddr 0x%-8x name `",
1916 (UInt32)reltab_j->Type,
1917 reltab_j->VirtualAddress );
1918 printName ( sym->Name, strtab );
1919 fprintf ( stderr, "'\n" ));
1921 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1922 COFF_section* section_sym
1923 = findPEi386SectionCalled ( oc, sym->Name );
1925 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1928 S = ((UInt32)(oc->image))
1929 + (section_sym->PointerToRawData
1932 copyName ( sym->Name, strtab, symbol, 1000-1 );
1933 (void*)S = lookupLocalSymbol( oc, symbol );
1934 if ((void*)S != NULL) goto foundit;
1935 (void*)S = lookupSymbol( symbol );
1936 if ((void*)S != NULL) goto foundit;
1937 zapTrailingAtSign ( symbol );
1938 (void*)S = lookupLocalSymbol( oc, symbol );
1939 if ((void*)S != NULL) goto foundit;
1940 (void*)S = lookupSymbol( symbol );
1941 if ((void*)S != NULL) goto foundit;
1942 /* Newline first because the interactive linker has printed "linking..." */
1943 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1947 checkProddableBlock(oc, pP);
1948 switch (reltab_j->Type) {
1949 case MYIMAGE_REL_I386_DIR32:
1952 case MYIMAGE_REL_I386_REL32:
1953 /* Tricky. We have to insert a displacement at
1954 pP which, when added to the PC for the _next_
1955 insn, gives the address of the target (S).
1956 Problem is to know the address of the next insn
1957 when we only know pP. We assume that this
1958 literal field is always the last in the insn,
1959 so that the address of the next insn is pP+4
1960 -- hence the constant 4.
1961 Also I don't know if A should be added, but so
1962 far it has always been zero.
1965 *pP = S - ((UInt32)pP) - 4;
1968 belch("%s: unhandled PEi386 relocation type %d",
1969 oc->fileName, reltab_j->Type);
1976 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1980 #endif /* defined(OBJFORMAT_PEi386) */
1983 /* --------------------------------------------------------------------------
1985 * ------------------------------------------------------------------------*/
1987 #if defined(OBJFORMAT_ELF)
1992 #if defined(sparc_TARGET_ARCH)
1993 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1994 #elif defined(i386_TARGET_ARCH)
1995 # define ELF_TARGET_386 /* Used inside <elf.h> */
1996 #elif defined (ia64_TARGET_ARCH)
1997 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
1999 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2000 # define ELF_NEED_GOT /* needs Global Offset Table */
2001 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2007 * Define a set of types which can be used for both ELF32 and ELF64
2011 #define ELFCLASS ELFCLASS64
2012 #define Elf_Addr Elf64_Addr
2013 #define Elf_Word Elf64_Word
2014 #define Elf_Sword Elf64_Sword
2015 #define Elf_Ehdr Elf64_Ehdr
2016 #define Elf_Phdr Elf64_Phdr
2017 #define Elf_Shdr Elf64_Shdr
2018 #define Elf_Sym Elf64_Sym
2019 #define Elf_Rel Elf64_Rel
2020 #define Elf_Rela Elf64_Rela
2021 #define ELF_ST_TYPE ELF64_ST_TYPE
2022 #define ELF_ST_BIND ELF64_ST_BIND
2023 #define ELF_R_TYPE ELF64_R_TYPE
2024 #define ELF_R_SYM ELF64_R_SYM
2026 #define ELFCLASS ELFCLASS32
2027 #define Elf_Addr Elf32_Addr
2028 #define Elf_Word Elf32_Word
2029 #define Elf_Sword Elf32_Sword
2030 #define Elf_Ehdr Elf32_Ehdr
2031 #define Elf_Phdr Elf32_Phdr
2032 #define Elf_Shdr Elf32_Shdr
2033 #define Elf_Sym Elf32_Sym
2034 #define Elf_Rel Elf32_Rel
2035 #define Elf_Rela Elf32_Rela
2036 #define ELF_ST_TYPE ELF32_ST_TYPE
2037 #define ELF_ST_BIND ELF32_ST_BIND
2038 #define ELF_R_TYPE ELF32_R_TYPE
2039 #define ELF_R_SYM ELF32_R_SYM
2044 * Functions to allocate entries in dynamic sections. Currently we simply
2045 * preallocate a large number, and we don't check if a entry for the given
2046 * target already exists (a linear search is too slow). Ideally these
2047 * entries would be associated with symbols.
2050 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2051 #define GOT_SIZE 0x20000
2052 #define FUNCTION_TABLE_SIZE 0x10000
2053 #define PLT_SIZE 0x08000
2056 static Elf_Addr got[GOT_SIZE];
2057 static unsigned int gotIndex;
2058 static Elf_Addr gp_val = (Elf_Addr)got;
2061 allocateGOTEntry(Elf_Addr target)
2065 if (gotIndex >= GOT_SIZE)
2066 barf("Global offset table overflow");
2068 entry = &got[gotIndex++];
2070 return (Elf_Addr)entry;
2074 #ifdef ELF_FUNCTION_DESC
2080 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2081 static unsigned int functionTableIndex;
2084 allocateFunctionDesc(Elf_Addr target)
2086 FunctionDesc *entry;
2088 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2089 barf("Function table overflow");
2091 entry = &functionTable[functionTableIndex++];
2093 entry->gp = (Elf_Addr)gp_val;
2094 return (Elf_Addr)entry;
2098 copyFunctionDesc(Elf_Addr target)
2100 FunctionDesc *olddesc = (FunctionDesc *)target;
2101 FunctionDesc *newdesc;
2103 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2104 newdesc->gp = olddesc->gp;
2105 return (Elf_Addr)newdesc;
2110 #ifdef ia64_TARGET_ARCH
2111 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2112 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2114 static unsigned char plt_code[] =
2116 /* taken from binutils bfd/elfxx-ia64.c */
2117 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2118 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2119 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2120 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2121 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2122 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2125 /* If we can't get to the function descriptor via gp, take a local copy of it */
2126 #define PLT_RELOC(code, target) { \
2127 Elf64_Sxword rel_value = target - gp_val; \
2128 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2129 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2131 ia64_reloc_gprel22((Elf_Addr)code, target); \
2136 unsigned char code[sizeof(plt_code)];
2140 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2142 PLTEntry *plt = (PLTEntry *)oc->plt;
2145 if (oc->pltIndex >= PLT_SIZE)
2146 barf("Procedure table overflow");
2148 entry = &plt[oc->pltIndex++];
2149 memcpy(entry->code, plt_code, sizeof(entry->code));
2150 PLT_RELOC(entry->code, target);
2151 return (Elf_Addr)entry;
2157 return (PLT_SIZE * sizeof(PLTEntry));
2163 * Generic ELF functions
2167 findElfSection ( void* objImage, Elf_Word sh_type )
2169 char* ehdrC = (char*)objImage;
2170 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2171 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2172 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2176 for (i = 0; i < ehdr->e_shnum; i++) {
2177 if (shdr[i].sh_type == sh_type
2178 /* Ignore the section header's string table. */
2179 && i != ehdr->e_shstrndx
2180 /* Ignore string tables named .stabstr, as they contain
2182 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2184 ptr = ehdrC + shdr[i].sh_offset;
2191 #if defined(ia64_TARGET_ARCH)
2193 findElfSegment ( void* objImage, Elf_Addr vaddr )
2195 char* ehdrC = (char*)objImage;
2196 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2197 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2198 Elf_Addr segaddr = 0;
2201 for (i = 0; i < ehdr->e_phnum; i++) {
2202 segaddr = phdr[i].p_vaddr;
2203 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2211 ocVerifyImage_ELF ( ObjectCode* oc )
2215 int i, j, nent, nstrtab, nsymtabs;
2219 char* ehdrC = (char*)(oc->image);
2220 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2222 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2223 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2224 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2225 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2226 belch("%s: not an ELF object", oc->fileName);
2230 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2231 belch("%s: unsupported ELF format", oc->fileName);
2235 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2236 IF_DEBUG(linker,belch( "Is little-endian" ));
2238 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2239 IF_DEBUG(linker,belch( "Is big-endian" ));
2241 belch("%s: unknown endiannness", oc->fileName);
2245 if (ehdr->e_type != ET_REL) {
2246 belch("%s: not a relocatable object (.o) file", oc->fileName);
2249 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2251 IF_DEBUG(linker,belch( "Architecture is " ));
2252 switch (ehdr->e_machine) {
2253 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2254 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2256 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2258 default: IF_DEBUG(linker,belch( "unknown" ));
2259 belch("%s: unknown architecture", oc->fileName);
2263 IF_DEBUG(linker,belch(
2264 "\nSection header table: start %d, n_entries %d, ent_size %d",
2265 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2267 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2269 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2271 if (ehdr->e_shstrndx == SHN_UNDEF) {
2272 belch("%s: no section header string table", oc->fileName);
2275 IF_DEBUG(linker,belch( "Section header string table is section %d",
2277 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2280 for (i = 0; i < ehdr->e_shnum; i++) {
2281 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2282 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2283 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2284 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2285 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2286 ehdrC + shdr[i].sh_offset,
2287 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2289 if (shdr[i].sh_type == SHT_REL) {
2290 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2291 } else if (shdr[i].sh_type == SHT_RELA) {
2292 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2294 IF_DEBUG(linker,fprintf(stderr," "));
2297 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2301 IF_DEBUG(linker,belch( "\nString tables" ));
2304 for (i = 0; i < ehdr->e_shnum; i++) {
2305 if (shdr[i].sh_type == SHT_STRTAB
2306 /* Ignore the section header's string table. */
2307 && i != ehdr->e_shstrndx
2308 /* Ignore string tables named .stabstr, as they contain
2310 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2312 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2313 strtab = ehdrC + shdr[i].sh_offset;
2318 belch("%s: no string tables, or too many", oc->fileName);
2323 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2324 for (i = 0; i < ehdr->e_shnum; i++) {
2325 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2326 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2328 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2329 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2330 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2332 shdr[i].sh_size % sizeof(Elf_Sym)
2334 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2335 belch("%s: non-integral number of symbol table entries", oc->fileName);
2338 for (j = 0; j < nent; j++) {
2339 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2340 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2341 (int)stab[j].st_shndx,
2342 (int)stab[j].st_size,
2343 (char*)stab[j].st_value ));
2345 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2346 switch (ELF_ST_TYPE(stab[j].st_info)) {
2347 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2348 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2349 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2350 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2351 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2352 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2354 IF_DEBUG(linker,fprintf(stderr, " " ));
2356 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2357 switch (ELF_ST_BIND(stab[j].st_info)) {
2358 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2359 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2360 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2361 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2363 IF_DEBUG(linker,fprintf(stderr, " " ));
2365 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2369 if (nsymtabs == 0) {
2370 belch("%s: didn't find any symbol tables", oc->fileName);
2379 ocGetNames_ELF ( ObjectCode* oc )
2384 char* ehdrC = (char*)(oc->image);
2385 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2386 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2387 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2389 ASSERT(symhash != NULL);
2392 belch("%s: no strtab", oc->fileName);
2397 for (i = 0; i < ehdr->e_shnum; i++) {
2398 /* Figure out what kind of section it is. Logic derived from
2399 Figure 1.14 ("Special Sections") of the ELF document
2400 ("Portable Formats Specification, Version 1.1"). */
2401 Elf_Shdr hdr = shdr[i];
2402 SectionKind kind = SECTIONKIND_OTHER;
2405 if (hdr.sh_type == SHT_PROGBITS
2406 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2407 /* .text-style section */
2408 kind = SECTIONKIND_CODE_OR_RODATA;
2411 if (hdr.sh_type == SHT_PROGBITS
2412 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2413 /* .data-style section */
2414 kind = SECTIONKIND_RWDATA;
2417 if (hdr.sh_type == SHT_PROGBITS
2418 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2419 /* .rodata-style section */
2420 kind = SECTIONKIND_CODE_OR_RODATA;
2423 if (hdr.sh_type == SHT_NOBITS
2424 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2425 /* .bss-style section */
2426 kind = SECTIONKIND_RWDATA;
2430 if (is_bss && shdr[i].sh_size > 0) {
2431 /* This is a non-empty .bss section. Allocate zeroed space for
2432 it, and set its .sh_offset field such that
2433 ehdrC + .sh_offset == addr_of_zeroed_space. */
2434 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2435 "ocGetNames_ELF(BSS)");
2436 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2438 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2439 zspace, shdr[i].sh_size);
2443 /* fill in the section info */
2444 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2445 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2446 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2447 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2450 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2452 /* copy stuff into this module's object symbol table */
2453 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2454 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2456 oc->n_symbols = nent;
2457 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2458 "ocGetNames_ELF(oc->symbols)");
2460 for (j = 0; j < nent; j++) {
2462 char isLocal = FALSE; /* avoids uninit-var warning */
2464 char* nm = strtab + stab[j].st_name;
2465 int secno = stab[j].st_shndx;
2467 /* Figure out if we want to add it; if so, set ad to its
2468 address. Otherwise leave ad == NULL. */
2470 if (secno == SHN_COMMON) {
2472 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2474 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2475 stab[j].st_size, nm);
2477 /* Pointless to do addProddableBlock() for this area,
2478 since the linker should never poke around in it. */
2481 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2482 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2484 /* and not an undefined symbol */
2485 && stab[j].st_shndx != SHN_UNDEF
2486 /* and not in a "special section" */
2487 && stab[j].st_shndx < SHN_LORESERVE
2489 /* and it's a not a section or string table or anything silly */
2490 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2491 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2492 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2495 /* Section 0 is the undefined section, hence > and not >=. */
2496 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2498 if (shdr[secno].sh_type == SHT_NOBITS) {
2499 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2500 stab[j].st_size, stab[j].st_value, nm);
2503 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2504 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2507 #ifdef ELF_FUNCTION_DESC
2508 /* dlsym() and the initialisation table both give us function
2509 * descriptors, so to be consistent we store function descriptors
2510 * in the symbol table */
2511 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2512 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2514 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2515 ad, oc->fileName, nm ));
2520 /* And the decision is ... */
2524 oc->symbols[j] = nm;
2527 /* Ignore entirely. */
2529 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2533 IF_DEBUG(linker,belch( "skipping `%s'",
2534 strtab + stab[j].st_name ));
2537 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2538 (int)ELF_ST_BIND(stab[j].st_info),
2539 (int)ELF_ST_TYPE(stab[j].st_info),
2540 (int)stab[j].st_shndx,
2541 strtab + stab[j].st_name
2544 oc->symbols[j] = NULL;
2553 /* Do ELF relocations which lack an explicit addend. All x86-linux
2554 relocations appear to be of this form. */
2556 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2557 Elf_Shdr* shdr, int shnum,
2558 Elf_Sym* stab, char* strtab )
2563 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2564 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2565 int target_shndx = shdr[shnum].sh_info;
2566 int symtab_shndx = shdr[shnum].sh_link;
2568 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2569 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2570 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2571 target_shndx, symtab_shndx ));
2573 for (j = 0; j < nent; j++) {
2574 Elf_Addr offset = rtab[j].r_offset;
2575 Elf_Addr info = rtab[j].r_info;
2577 Elf_Addr P = ((Elf_Addr)targ) + offset;
2578 Elf_Word* pP = (Elf_Word*)P;
2583 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2584 j, (void*)offset, (void*)info ));
2586 IF_DEBUG(linker,belch( " ZERO" ));
2589 Elf_Sym sym = stab[ELF_R_SYM(info)];
2590 /* First see if it is a local symbol. */
2591 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2592 /* Yes, so we can get the address directly from the ELF symbol
2594 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2596 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2597 + stab[ELF_R_SYM(info)].st_value);
2600 /* No, so look up the name in our global table. */
2601 symbol = strtab + sym.st_name;
2602 (void*)S = lookupSymbol( symbol );
2605 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2608 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2611 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2612 (void*)P, (void*)S, (void*)A ));
2613 checkProddableBlock ( oc, pP );
2617 switch (ELF_R_TYPE(info)) {
2618 # ifdef i386_TARGET_ARCH
2619 case R_386_32: *pP = value; break;
2620 case R_386_PC32: *pP = value - P; break;
2623 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2624 oc->fileName, ELF_R_TYPE(info));
2632 /* Do ELF relocations for which explicit addends are supplied.
2633 sparc-solaris relocations appear to be of this form. */
2635 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2636 Elf_Shdr* shdr, int shnum,
2637 Elf_Sym* stab, char* strtab )
2642 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2643 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2644 int target_shndx = shdr[shnum].sh_info;
2645 int symtab_shndx = shdr[shnum].sh_link;
2647 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2648 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2649 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2650 target_shndx, symtab_shndx ));
2652 for (j = 0; j < nent; j++) {
2653 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2654 /* This #ifdef only serves to avoid unused-var warnings. */
2655 Elf_Addr offset = rtab[j].r_offset;
2656 Elf_Addr P = targ + offset;
2658 Elf_Addr info = rtab[j].r_info;
2659 Elf_Addr A = rtab[j].r_addend;
2662 # if defined(sparc_TARGET_ARCH)
2663 Elf_Word* pP = (Elf_Word*)P;
2665 # elif defined(ia64_TARGET_ARCH)
2666 Elf64_Xword *pP = (Elf64_Xword *)P;
2670 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2671 j, (void*)offset, (void*)info,
2674 IF_DEBUG(linker,belch( " ZERO" ));
2677 Elf_Sym sym = stab[ELF_R_SYM(info)];
2678 /* First see if it is a local symbol. */
2679 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2680 /* Yes, so we can get the address directly from the ELF symbol
2682 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2684 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2685 + stab[ELF_R_SYM(info)].st_value);
2686 #ifdef ELF_FUNCTION_DESC
2687 /* Make a function descriptor for this function */
2688 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2689 S = allocateFunctionDesc(S + A);
2694 /* No, so look up the name in our global table. */
2695 symbol = strtab + sym.st_name;
2696 (void*)S = lookupSymbol( symbol );
2698 #ifdef ELF_FUNCTION_DESC
2699 /* If a function, already a function descriptor - we would
2700 have to copy it to add an offset. */
2701 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2706 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2709 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2712 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2713 (void*)P, (void*)S, (void*)A ));
2714 /* checkProddableBlock ( oc, (void*)P ); */
2718 switch (ELF_R_TYPE(info)) {
2719 # if defined(sparc_TARGET_ARCH)
2720 case R_SPARC_WDISP30:
2721 w1 = *pP & 0xC0000000;
2722 w2 = (Elf_Word)((value - P) >> 2);
2723 ASSERT((w2 & 0xC0000000) == 0);
2728 w1 = *pP & 0xFFC00000;
2729 w2 = (Elf_Word)(value >> 10);
2730 ASSERT((w2 & 0xFFC00000) == 0);
2736 w2 = (Elf_Word)(value & 0x3FF);
2737 ASSERT((w2 & ~0x3FF) == 0);
2741 /* According to the Sun documentation:
2743 This relocation type resembles R_SPARC_32, except it refers to an
2744 unaligned word. That is, the word to be relocated must be treated
2745 as four separate bytes with arbitrary alignment, not as a word
2746 aligned according to the architecture requirements.
2748 (JRS: which means that freeloading on the R_SPARC_32 case
2749 is probably wrong, but hey ...)
2753 w2 = (Elf_Word)value;
2756 # elif defined(ia64_TARGET_ARCH)
2757 case R_IA64_DIR64LSB:
2758 case R_IA64_FPTR64LSB:
2761 case R_IA64_SEGREL64LSB:
2762 addr = findElfSegment(ehdrC, value);
2765 case R_IA64_GPREL22:
2766 ia64_reloc_gprel22(P, value);
2768 case R_IA64_LTOFF22:
2769 case R_IA64_LTOFF_FPTR22:
2770 addr = allocateGOTEntry(value);
2771 ia64_reloc_gprel22(P, addr);
2773 case R_IA64_PCREL21B:
2774 ia64_reloc_pcrel21(P, S, oc);
2778 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2779 oc->fileName, ELF_R_TYPE(info));
2788 ocResolve_ELF ( ObjectCode* oc )
2792 Elf_Sym* stab = NULL;
2793 char* ehdrC = (char*)(oc->image);
2794 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2795 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2796 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2798 /* first find "the" symbol table */
2799 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2801 /* also go find the string table */
2802 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2804 if (stab == NULL || strtab == NULL) {
2805 belch("%s: can't find string or symbol table", oc->fileName);
2809 /* Process the relocation sections. */
2810 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2812 /* Skip sections called ".rel.stab". These appear to contain
2813 relocation entries that, when done, make the stabs debugging
2814 info point at the right places. We ain't interested in all
2816 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2819 if (shdr[shnum].sh_type == SHT_REL ) {
2820 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2821 shnum, stab, strtab );
2825 if (shdr[shnum].sh_type == SHT_RELA) {
2826 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2827 shnum, stab, strtab );
2832 /* Free the local symbol table; we won't need it again. */
2833 freeHashTable(oc->lochash, NULL);
2841 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2842 * at the front. The following utility functions pack and unpack instructions, and
2843 * take care of the most common relocations.
2846 #ifdef ia64_TARGET_ARCH
2849 ia64_extract_instruction(Elf64_Xword *target)
2852 int slot = (Elf_Addr)target & 3;
2853 (Elf_Addr)target &= ~3;
2861 return ((w1 >> 5) & 0x1ffffffffff);
2863 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2867 barf("ia64_extract_instruction: invalid slot %p", target);
2872 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2874 int slot = (Elf_Addr)target & 3;
2875 (Elf_Addr)target &= ~3;
2880 *target |= value << 5;
2883 *target |= value << 46;
2884 *(target+1) |= value >> 18;
2887 *(target+1) |= value << 23;
2893 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2895 Elf64_Xword instruction;
2896 Elf64_Sxword rel_value;
2898 rel_value = value - gp_val;
2899 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2900 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2902 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2903 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2904 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2905 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2906 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2907 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2911 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2913 Elf64_Xword instruction;
2914 Elf64_Sxword rel_value;
2917 entry = allocatePLTEntry(value, oc);
2919 rel_value = (entry >> 4) - (target >> 4);
2920 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2921 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2923 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2924 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2925 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2926 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2933 /* --------------------------------------------------------------------------
2935 * ------------------------------------------------------------------------*/
2937 #if defined(OBJFORMAT_MACHO)
2940 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2941 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2943 I hereby formally apologize for the hackish nature of this code.
2944 Things that need to be done:
2945 *) get common symbols and .bss sections to work properly.
2946 Haskell modules seem to work, but C modules can cause problems
2947 *) implement ocVerifyImage_MachO
2948 *) add more sanity checks. The current code just has to segfault if there's a
2952 static int ocVerifyImage_MachO(ObjectCode* oc)
2954 // FIXME: do some verifying here
2958 static int resolveImports(
2961 struct symtab_command *symLC,
2962 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2963 unsigned long *indirectSyms,
2964 struct nlist *nlist)
2968 for(i=0;i*4<sect->size;i++)
2970 // according to otool, reserved1 contains the first index into the indirect symbol table
2971 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2972 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2975 if((symbol->n_type & N_TYPE) == N_UNDF
2976 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
2977 addr = (void*) (symbol->n_value);
2978 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
2981 addr = lookupSymbol(nm);
2984 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
2988 ((void**)(image + sect->offset))[i] = addr;
2994 static int relocateSection(char *image,
2995 struct symtab_command *symLC, struct nlist *nlist,
2996 struct section* sections, struct section *sect)
2998 struct relocation_info *relocs;
3001 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3003 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3007 relocs = (struct relocation_info*) (image + sect->reloff);
3011 if(relocs[i].r_address & R_SCATTERED)
3013 struct scattered_relocation_info *scat =
3014 (struct scattered_relocation_info*) &relocs[i];
3018 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3020 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3022 *word = scat->r_value + sect->offset + ((long) image);
3026 continue; // FIXME: I hope it's OK to ignore all the others.
3030 struct relocation_info *reloc = &relocs[i];
3031 if(reloc->r_pcrel && !reloc->r_extern)
3034 if(reloc->r_length == 2)
3036 unsigned long word = 0;
3038 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3040 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3044 else if(reloc->r_type == PPC_RELOC_LO16)
3046 word = ((unsigned short*) wordPtr)[1];
3047 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3049 else if(reloc->r_type == PPC_RELOC_HI16)
3051 word = ((unsigned short*) wordPtr)[1] << 16;
3052 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3054 else if(reloc->r_type == PPC_RELOC_HA16)
3056 word = ((unsigned short*) wordPtr)[1] << 16;
3057 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3059 else if(reloc->r_type == PPC_RELOC_BR24)
3062 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3066 if(!reloc->r_extern)
3069 sections[reloc->r_symbolnum-1].offset
3070 - sections[reloc->r_symbolnum-1].addr
3077 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3078 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3079 word = (unsigned long) (lookupSymbol(nm));
3082 belch("\nunknown symbol `%s'", nm);
3087 word -= ((long)image) + sect->offset + reloc->r_address;
3090 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3095 else if(reloc->r_type == PPC_RELOC_LO16)
3097 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3100 else if(reloc->r_type == PPC_RELOC_HI16)
3102 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3105 else if(reloc->r_type == PPC_RELOC_HA16)
3107 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3108 + ((word & (1<<15)) ? 1 : 0);
3111 else if(reloc->r_type == PPC_RELOC_BR24)
3113 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3117 barf("\nunknown relocation %d",reloc->r_type);
3124 static int ocGetNames_MachO(ObjectCode* oc)
3126 char *image = (char*) oc->image;
3127 struct mach_header *header = (struct mach_header*) image;
3128 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3129 unsigned i,curSymbol;
3130 struct segment_command *segLC = NULL;
3131 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3132 struct symtab_command *symLC = NULL;
3133 struct dysymtab_command *dsymLC = NULL;
3134 struct nlist *nlist;
3135 unsigned long commonSize = 0;
3136 char *commonStorage = NULL;
3137 unsigned long commonCounter;
3139 for(i=0;i<header->ncmds;i++)
3141 if(lc->cmd == LC_SEGMENT)
3142 segLC = (struct segment_command*) lc;
3143 else if(lc->cmd == LC_SYMTAB)
3144 symLC = (struct symtab_command*) lc;
3145 else if(lc->cmd == LC_DYSYMTAB)
3146 dsymLC = (struct dysymtab_command*) lc;
3147 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3150 sections = (struct section*) (segLC+1);
3151 nlist = (struct nlist*) (image + symLC->symoff);
3153 for(i=0;i<segLC->nsects;i++)
3155 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3156 la_ptrs = §ions[i];
3157 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3158 nl_ptrs = §ions[i];
3160 // for now, only add __text and __const to the sections table
3161 else if(!strcmp(sections[i].sectname,"__text"))
3162 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3163 (void*) (image + sections[i].offset),
3164 (void*) (image + sections[i].offset + sections[i].size));
3165 else if(!strcmp(sections[i].sectname,"__const"))
3166 addSection(oc, SECTIONKIND_RWDATA,
3167 (void*) (image + sections[i].offset),
3168 (void*) (image + sections[i].offset + sections[i].size));
3169 else if(!strcmp(sections[i].sectname,"__data"))
3170 addSection(oc, SECTIONKIND_RWDATA,
3171 (void*) (image + sections[i].offset),
3172 (void*) (image + sections[i].offset + sections[i].size));
3175 // count external symbols defined here
3177 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3179 if((nlist[i].n_type & N_TYPE) == N_SECT)
3182 for(i=0;i<symLC->nsyms;i++)
3184 if((nlist[i].n_type & N_TYPE) == N_UNDF
3185 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3187 commonSize += nlist[i].n_value;
3191 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3192 "ocGetNames_MachO(oc->symbols)");
3194 // insert symbols into hash table
3195 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3197 if((nlist[i].n_type & N_TYPE) == N_SECT)
3199 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3200 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3201 sections[nlist[i].n_sect-1].offset
3202 - sections[nlist[i].n_sect-1].addr
3203 + nlist[i].n_value);
3204 oc->symbols[curSymbol++] = nm;
3208 // insert local symbols into lochash
3209 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3211 if((nlist[i].n_type & N_TYPE) == N_SECT)
3213 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3214 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3215 sections[nlist[i].n_sect-1].offset
3216 - sections[nlist[i].n_sect-1].addr
3217 + nlist[i].n_value);
3222 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3223 commonCounter = (unsigned long)commonStorage;
3224 for(i=0;i<symLC->nsyms;i++)
3226 if((nlist[i].n_type & N_TYPE) == N_UNDF
3227 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3229 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3230 unsigned long sz = nlist[i].n_value;
3232 nlist[i].n_value = commonCounter;
3234 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3235 oc->symbols[curSymbol++] = nm;
3237 commonCounter += sz;
3243 static int ocResolve_MachO(ObjectCode* oc)
3245 char *image = (char*) oc->image;
3246 struct mach_header *header = (struct mach_header*) image;
3247 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3249 struct segment_command *segLC = NULL;
3250 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3251 struct symtab_command *symLC = NULL;
3252 struct dysymtab_command *dsymLC = NULL;
3253 struct nlist *nlist;
3254 unsigned long *indirectSyms;
3256 for(i=0;i<header->ncmds;i++)
3258 if(lc->cmd == LC_SEGMENT)
3259 segLC = (struct segment_command*) lc;
3260 else if(lc->cmd == LC_SYMTAB)
3261 symLC = (struct symtab_command*) lc;
3262 else if(lc->cmd == LC_DYSYMTAB)
3263 dsymLC = (struct dysymtab_command*) lc;
3264 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3267 sections = (struct section*) (segLC+1);
3268 nlist = (struct nlist*) (image + symLC->symoff);
3270 for(i=0;i<segLC->nsects;i++)
3272 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3273 la_ptrs = §ions[i];
3274 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3275 nl_ptrs = §ions[i];
3278 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3281 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3284 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3287 for(i=0;i<segLC->nsects;i++)
3289 if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
3293 /* Free the local symbol table; we won't need it again. */
3294 freeHashTable(oc->lochash, NULL);
3300 * The Mach-O object format uses leading underscores. But not everywhere.
3301 * There is a small number of runtime support functions defined in
3302 * libcc_dynamic.a whose name does not have a leading underscore.
3303 * As a consequence, we can't get their address from C code.
3304 * We have to use inline assembler just to take the address of a function.
3308 static void machoInitSymbolsWithoutUnderscore()
3314 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3315 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3317 RTS_MACHO_NOUNDERLINE_SYMBOLS