1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.116 2003/03/25 17:58:47 sof Exp $
4 * (c) The GHC Team, 2000, 2001
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)
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();
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 \
214 #elif !defined(mingw32_TARGET_OS)
215 #define RTS_MINGW_ONLY_SYMBOLS /**/
216 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
217 #else /* defined(mingw32_TARGET_OS) */
218 #define RTS_POSIX_ONLY_SYMBOLS /**/
219 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
221 /* These are statically linked from the mingw libraries into the ghc
222 executable, so we have to employ this hack. */
223 #define RTS_MINGW_ONLY_SYMBOLS \
224 SymX(asyncReadzh_fast) \
225 SymX(asyncWritezh_fast) \
237 SymX(getservbyname) \
238 SymX(getservbyport) \
239 SymX(getprotobynumber) \
240 SymX(getprotobyname) \
241 SymX(gethostbyname) \
242 SymX(gethostbyaddr) \
277 Sym(_imp___timezone) \
293 # define MAIN_CAP_SYM SymX(MainCapability)
295 # define MAIN_CAP_SYM
298 #define RTS_SYMBOLS \
302 SymX(stg_enter_info) \
303 SymX(stg_enter_ret) \
304 SymX(stg_gc_void_info) \
305 SymX(__stg_gc_enter_1) \
306 SymX(stg_gc_noregs) \
307 SymX(stg_gc_unpt_r1_info) \
308 SymX(stg_gc_unpt_r1) \
309 SymX(stg_gc_unbx_r1_info) \
310 SymX(stg_gc_unbx_r1) \
311 SymX(stg_gc_f1_info) \
313 SymX(stg_gc_d1_info) \
315 SymX(stg_gc_l1_info) \
318 SymX(stg_gc_fun_info) \
319 SymX(stg_gc_fun_ret) \
321 SymX(stg_gc_gen_info) \
322 SymX(stg_gc_gen_hp) \
324 SymX(stg_gen_yield) \
325 SymX(stg_yield_noregs) \
326 SymX(stg_yield_to_interpreter) \
327 SymX(stg_gen_block) \
328 SymX(stg_block_noregs) \
330 SymX(stg_block_takemvar) \
331 SymX(stg_block_putmvar) \
332 SymX(stg_seq_frame_info) \
335 SymX(MallocFailHook) \
337 SymX(OutOfHeapHook) \
338 SymX(PatErrorHdrHook) \
339 SymX(PostTraceHook) \
341 SymX(StackOverflowHook) \
342 SymX(__encodeDouble) \
343 SymX(__encodeFloat) \
346 SymX(__gmpz_cmp_si) \
347 SymX(__gmpz_cmp_ui) \
348 SymX(__gmpz_get_si) \
349 SymX(__gmpz_get_ui) \
350 SymX(__int_encodeDouble) \
351 SymX(__int_encodeFloat) \
352 SymX(andIntegerzh_fast) \
353 SymX(blockAsyncExceptionszh_fast) \
356 SymX(complementIntegerzh_fast) \
357 SymX(cmpIntegerzh_fast) \
358 SymX(cmpIntegerIntzh_fast) \
359 SymX(createAdjustor) \
360 SymX(decodeDoublezh_fast) \
361 SymX(decodeFloatzh_fast) \
364 SymX(deRefWeakzh_fast) \
365 SymX(deRefStablePtrzh_fast) \
366 SymX(divExactIntegerzh_fast) \
367 SymX(divModIntegerzh_fast) \
369 SymX(forkProcesszh_fast) \
370 SymX(freeHaskellFunctionPtr) \
371 SymX(freeStablePtr) \
372 SymX(gcdIntegerzh_fast) \
373 SymX(gcdIntegerIntzh_fast) \
374 SymX(gcdIntzh_fast) \
377 SymX(int2Integerzh_fast) \
378 SymX(integer2Intzh_fast) \
379 SymX(integer2Wordzh_fast) \
380 SymX(isDoubleDenormalized) \
381 SymX(isDoubleInfinite) \
383 SymX(isDoubleNegativeZero) \
384 SymX(isEmptyMVarzh_fast) \
385 SymX(isFloatDenormalized) \
386 SymX(isFloatInfinite) \
388 SymX(isFloatNegativeZero) \
389 SymX(killThreadzh_fast) \
390 SymX(makeStablePtrzh_fast) \
391 SymX(minusIntegerzh_fast) \
392 SymX(mkApUpd0zh_fast) \
393 SymX(myThreadIdzh_fast) \
394 SymX(labelThreadzh_fast) \
395 SymX(newArrayzh_fast) \
396 SymX(newBCOzh_fast) \
397 SymX(newByteArrayzh_fast) \
398 SymX_redirect(newCAF, newDynCAF) \
399 SymX(newMVarzh_fast) \
400 SymX(newMutVarzh_fast) \
401 SymX(atomicModifyMutVarzh_fast) \
402 SymX(newPinnedByteArrayzh_fast) \
403 SymX(orIntegerzh_fast) \
405 SymX(plusIntegerzh_fast) \
408 SymX(putMVarzh_fast) \
409 SymX(quotIntegerzh_fast) \
410 SymX(quotRemIntegerzh_fast) \
412 SymX(remIntegerzh_fast) \
413 SymX(resetNonBlockingFd) \
416 SymX(rts_checkSchedStatus) \
419 SymX(rts_evalLazyIO) \
423 SymX(rts_getDouble) \
428 SymX(rts_getFunPtr) \
429 SymX(rts_getStablePtr) \
430 SymX(rts_getThreadId) \
432 SymX(rts_getWord32) \
445 SymX(rts_mkStablePtr) \
455 SymX(startupHaskell) \
456 SymX(shutdownHaskell) \
457 SymX(shutdownHaskellAndExit) \
458 SymX(stable_ptr_table) \
459 SymX(stackOverflow) \
460 SymX(stg_CAF_BLACKHOLE_info) \
461 SymX(stg_CHARLIKE_closure) \
462 SymX(stg_EMPTY_MVAR_info) \
463 SymX(stg_IND_STATIC_info) \
464 SymX(stg_INTLIKE_closure) \
465 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
466 SymX(stg_WEAK_info) \
467 SymX(stg_ap_v_info) \
468 SymX(stg_ap_f_info) \
469 SymX(stg_ap_d_info) \
470 SymX(stg_ap_l_info) \
471 SymX(stg_ap_n_info) \
472 SymX(stg_ap_p_info) \
473 SymX(stg_ap_pv_info) \
474 SymX(stg_ap_pp_info) \
475 SymX(stg_ap_ppv_info) \
476 SymX(stg_ap_ppp_info) \
477 SymX(stg_ap_pppp_info) \
478 SymX(stg_ap_ppppp_info) \
479 SymX(stg_ap_pppppp_info) \
480 SymX(stg_ap_ppppppp_info) \
488 SymX(stg_ap_pv_ret) \
489 SymX(stg_ap_pp_ret) \
490 SymX(stg_ap_ppv_ret) \
491 SymX(stg_ap_ppp_ret) \
492 SymX(stg_ap_pppp_ret) \
493 SymX(stg_ap_ppppp_ret) \
494 SymX(stg_ap_pppppp_ret) \
495 SymX(stg_ap_ppppppp_ret) \
496 SymX(stg_ap_1_upd_info) \
497 SymX(stg_ap_2_upd_info) \
498 SymX(stg_ap_3_upd_info) \
499 SymX(stg_ap_4_upd_info) \
500 SymX(stg_ap_5_upd_info) \
501 SymX(stg_ap_6_upd_info) \
502 SymX(stg_ap_7_upd_info) \
503 SymX(stg_ap_8_upd_info) \
505 SymX(stg_sel_0_upd_info) \
506 SymX(stg_sel_10_upd_info) \
507 SymX(stg_sel_11_upd_info) \
508 SymX(stg_sel_12_upd_info) \
509 SymX(stg_sel_13_upd_info) \
510 SymX(stg_sel_14_upd_info) \
511 SymX(stg_sel_15_upd_info) \
512 SymX(stg_sel_1_upd_info) \
513 SymX(stg_sel_2_upd_info) \
514 SymX(stg_sel_3_upd_info) \
515 SymX(stg_sel_4_upd_info) \
516 SymX(stg_sel_5_upd_info) \
517 SymX(stg_sel_6_upd_info) \
518 SymX(stg_sel_7_upd_info) \
519 SymX(stg_sel_8_upd_info) \
520 SymX(stg_sel_9_upd_info) \
521 SymX(stg_upd_frame_info) \
522 SymX(suspendThread) \
523 SymX(takeMVarzh_fast) \
524 SymX(timesIntegerzh_fast) \
525 SymX(tryPutMVarzh_fast) \
526 SymX(tryTakeMVarzh_fast) \
527 SymX(unblockAsyncExceptionszh_fast) \
528 SymX(unsafeThawArrayzh_fast) \
529 SymX(waitReadzh_fast) \
530 SymX(waitWritezh_fast) \
531 SymX(word2Integerzh_fast) \
532 SymX(xorIntegerzh_fast) \
535 #ifdef SUPPORT_LONG_LONGS
536 #define RTS_LONG_LONG_SYMS \
537 SymX(int64ToIntegerzh_fast) \
538 SymX(word64ToIntegerzh_fast)
540 #define RTS_LONG_LONG_SYMS /* nothing */
543 #ifdef ia64_TARGET_ARCH
544 /* force these symbols to be present */
545 #define RTS_EXTRA_SYMBOLS \
547 #elif defined(powerpc_TARGET_ARCH)
548 #define RTS_EXTRA_SYMBOLS \
558 // Symbols that don't have a leading underscore
559 // on Mac OS X. They have to receive special treatment,
560 // see machoInitSymbolsWithoutUnderscore()
561 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
565 #define RTS_EXTRA_SYMBOLS /* nothing */
568 /* entirely bogus claims about types of these symbols */
569 #define Sym(vvv) extern void (vvv);
570 #define SymX(vvv) /**/
571 #define SymX_redirect(vvv,xxx) /**/
575 RTS_POSIX_ONLY_SYMBOLS
576 RTS_MINGW_ONLY_SYMBOLS
577 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
605 { 0, 0 } /* sentinel */
608 /* -----------------------------------------------------------------------------
609 * Insert symbols into hash tables, checking for duplicates.
611 static void ghciInsertStrHashTable ( char* obj_name,
617 if (lookupHashTable(table, (StgWord)key) == NULL)
619 insertStrHashTable(table, (StgWord)key, data);
624 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
626 "whilst processing object file\n"
628 "This could be caused by:\n"
629 " * Loading two different object files which export the same symbol\n"
630 " * Specifying the same object file twice on the GHCi command line\n"
631 " * An incorrect `package.conf' entry, causing some object to be\n"
633 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
642 /* -----------------------------------------------------------------------------
643 * initialize the object linker
647 static int linker_init_done = 0 ;
649 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
650 static void *dl_prog_handle;
658 /* Make initLinker idempotent, so we can call it
659 before evey relevant operation; that means we
660 don't need to initialise the linker separately */
661 if (linker_init_done == 1) { return; } else {
662 linker_init_done = 1;
665 symhash = allocStrHashTable();
667 /* populate the symbol table with stuff from the RTS */
668 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
669 ghciInsertStrHashTable("(GHCi built-in symbols)",
670 symhash, sym->lbl, sym->addr);
672 # if defined(OBJFORMAT_MACHO)
673 machoInitSymbolsWithoutUnderscore();
676 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
677 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
681 /* -----------------------------------------------------------------------------
682 * Loading DLL or .so dynamic libraries
683 * -----------------------------------------------------------------------------
685 * Add a DLL from which symbols may be found. In the ELF case, just
686 * do RTLD_GLOBAL-style add, so no further messing around needs to
687 * happen in order that symbols in the loaded .so are findable --
688 * lookupSymbol() will subsequently see them by dlsym on the program's
689 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
691 * In the PEi386 case, open the DLLs and put handles to them in a
692 * linked list. When looking for a symbol, try all handles in the
693 * list. This means that we need to load even DLLs that are guaranteed
694 * to be in the ghc.exe image already, just so we can get a handle
695 * to give to loadSymbol, so that we can find the symbols. For such
696 * libraries, the LoadLibrary call should be a no-op except for returning
701 #if defined(OBJFORMAT_PEi386)
702 /* A record for storing handles into DLLs. */
707 struct _OpenedDLL* next;
712 /* A list thereof. */
713 static OpenedDLL* opened_dlls = NULL;
717 addDLL( char *dll_name )
719 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
720 /* ------------------- ELF DLL loader ------------------- */
726 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
728 /* dlopen failed; return a ptr to the error msg. */
730 if (errmsg == NULL) errmsg = "addDLL: unknown error";
737 # elif defined(OBJFORMAT_PEi386)
738 /* ------------------- Win32 DLL loader ------------------- */
746 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
748 /* See if we've already got it, and ignore if so. */
749 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
750 if (0 == strcmp(o_dll->name, dll_name))
754 /* The file name has no suffix (yet) so that we can try
755 both foo.dll and foo.drv
757 The documentation for LoadLibrary says:
758 If no file name extension is specified in the lpFileName
759 parameter, the default library extension .dll is
760 appended. However, the file name string can include a trailing
761 point character (.) to indicate that the module name has no
764 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
765 sprintf(buf, "%s.DLL", dll_name);
766 instance = LoadLibrary(buf);
767 if (instance == NULL) {
768 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
769 instance = LoadLibrary(buf);
770 if (instance == NULL) {
773 /* LoadLibrary failed; return a ptr to the error msg. */
774 return "addDLL: unknown error";
779 /* Add this DLL to the list of DLLs in which to search for symbols. */
780 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
781 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
782 strcpy(o_dll->name, dll_name);
783 o_dll->instance = instance;
784 o_dll->next = opened_dlls;
789 barf("addDLL: not implemented on this platform");
793 /* -----------------------------------------------------------------------------
794 * lookup a symbol in the hash table
797 lookupSymbol( char *lbl )
801 ASSERT(symhash != NULL);
802 val = lookupStrHashTable(symhash, lbl);
805 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
806 return dlsym(dl_prog_handle, lbl);
807 # elif defined(OBJFORMAT_PEi386)
810 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
811 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
813 /* HACK: if the name has an initial underscore, try stripping
814 it off & look that up first. I've yet to verify whether there's
815 a Rule that governs whether an initial '_' *should always* be
816 stripped off when mapping from import lib name to the DLL name.
818 sym = GetProcAddress(o_dll->instance, (lbl+1));
820 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
824 sym = GetProcAddress(o_dll->instance, lbl);
826 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
841 __attribute((unused))
843 lookupLocalSymbol( ObjectCode* oc, char *lbl )
847 val = lookupStrHashTable(oc->lochash, lbl);
857 /* -----------------------------------------------------------------------------
858 * Debugging aid: look in GHCi's object symbol tables for symbols
859 * within DELTA bytes of the specified address, and show their names.
862 void ghci_enquire ( char* addr );
864 void ghci_enquire ( char* addr )
869 const int DELTA = 64;
874 for (oc = objects; oc; oc = oc->next) {
875 for (i = 0; i < oc->n_symbols; i++) {
876 sym = oc->symbols[i];
877 if (sym == NULL) continue;
878 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
880 if (oc->lochash != NULL) {
881 a = lookupStrHashTable(oc->lochash, sym);
884 a = lookupStrHashTable(symhash, sym);
887 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
889 else if (addr-DELTA <= a && a <= addr+DELTA) {
890 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
897 #ifdef ia64_TARGET_ARCH
898 static unsigned int PLTSize(void);
901 /* -----------------------------------------------------------------------------
902 * Load an obj (populate the global symbol table, but don't resolve yet)
904 * Returns: 1 if ok, 0 on error.
907 loadObj( char *path )
921 /* fprintf(stderr, "loadObj %s\n", path ); */
923 /* Check that we haven't already loaded this object. Don't give up
924 at this stage; ocGetNames_* will barf later. */
928 for (o = objects; o; o = o->next) {
929 if (0 == strcmp(o->fileName, path))
935 "GHCi runtime linker: warning: looks like you're trying to load the\n"
936 "same object file twice:\n"
938 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
944 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
946 # if defined(OBJFORMAT_ELF)
947 oc->formatName = "ELF";
948 # elif defined(OBJFORMAT_PEi386)
949 oc->formatName = "PEi386";
950 # elif defined(OBJFORMAT_MACHO)
951 oc->formatName = "Mach-O";
954 barf("loadObj: not implemented on this platform");
958 if (r == -1) { return 0; }
960 /* sigh, strdup() isn't a POSIX function, so do it the long way */
961 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
962 strcpy(oc->fileName, path);
964 oc->fileSize = st.st_size;
967 oc->lochash = allocStrHashTable();
968 oc->proddables = NULL;
970 /* chain it onto the list of objects */
975 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
977 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
979 fd = open(path, O_RDONLY);
981 barf("loadObj: can't open `%s'", path);
983 pagesize = getpagesize();
985 #ifdef ia64_TARGET_ARCH
986 /* The PLT needs to be right before the object */
987 n = ROUND_UP(PLTSize(), pagesize);
988 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
989 if (oc->plt == MAP_FAILED)
990 barf("loadObj: can't allocate PLT");
993 map_addr = oc->plt + n;
996 n = ROUND_UP(oc->fileSize, pagesize);
997 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
998 if (oc->image == MAP_FAILED)
999 barf("loadObj: can't map `%s'", path);
1003 #else /* !USE_MMAP */
1005 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1007 /* load the image into memory */
1008 f = fopen(path, "rb");
1010 barf("loadObj: can't read `%s'", path);
1012 n = fread ( oc->image, 1, oc->fileSize, f );
1013 if (n != oc->fileSize)
1014 barf("loadObj: error whilst reading `%s'", path);
1018 #endif /* USE_MMAP */
1020 /* verify the in-memory image */
1021 # if defined(OBJFORMAT_ELF)
1022 r = ocVerifyImage_ELF ( oc );
1023 # elif defined(OBJFORMAT_PEi386)
1024 r = ocVerifyImage_PEi386 ( oc );
1025 # elif defined(OBJFORMAT_MACHO)
1026 r = ocVerifyImage_MachO ( oc );
1028 barf("loadObj: no verify method");
1030 if (!r) { return r; }
1032 /* build the symbol list for this image */
1033 # if defined(OBJFORMAT_ELF)
1034 r = ocGetNames_ELF ( oc );
1035 # elif defined(OBJFORMAT_PEi386)
1036 r = ocGetNames_PEi386 ( oc );
1037 # elif defined(OBJFORMAT_MACHO)
1038 r = ocGetNames_MachO ( oc );
1040 barf("loadObj: no getNames method");
1042 if (!r) { return r; }
1044 /* loaded, but not resolved yet */
1045 oc->status = OBJECT_LOADED;
1050 /* -----------------------------------------------------------------------------
1051 * resolve all the currently unlinked objects in memory
1053 * Returns: 1 if ok, 0 on error.
1063 for (oc = objects; oc; oc = oc->next) {
1064 if (oc->status != OBJECT_RESOLVED) {
1065 # if defined(OBJFORMAT_ELF)
1066 r = ocResolve_ELF ( oc );
1067 # elif defined(OBJFORMAT_PEi386)
1068 r = ocResolve_PEi386 ( oc );
1069 # elif defined(OBJFORMAT_MACHO)
1070 r = ocResolve_MachO ( oc );
1072 barf("resolveObjs: not implemented on this platform");
1074 if (!r) { return r; }
1075 oc->status = OBJECT_RESOLVED;
1081 /* -----------------------------------------------------------------------------
1082 * delete an object from the pool
1085 unloadObj( char *path )
1087 ObjectCode *oc, *prev;
1089 ASSERT(symhash != NULL);
1090 ASSERT(objects != NULL);
1095 for (oc = objects; oc; prev = oc, oc = oc->next) {
1096 if (!strcmp(oc->fileName,path)) {
1098 /* Remove all the mappings for the symbols within this
1103 for (i = 0; i < oc->n_symbols; i++) {
1104 if (oc->symbols[i] != NULL) {
1105 removeStrHashTable(symhash, oc->symbols[i], NULL);
1113 prev->next = oc->next;
1116 /* We're going to leave this in place, in case there are
1117 any pointers from the heap into it: */
1118 /* stgFree(oc->image); */
1119 stgFree(oc->fileName);
1120 stgFree(oc->symbols);
1121 stgFree(oc->sections);
1122 /* The local hash table should have been freed at the end
1123 of the ocResolve_ call on it. */
1124 ASSERT(oc->lochash == NULL);
1130 belch("unloadObj: can't find `%s' to unload", path);
1134 /* -----------------------------------------------------------------------------
1135 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1136 * which may be prodded during relocation, and abort if we try and write
1137 * outside any of these.
1139 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1142 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1143 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1147 pb->next = oc->proddables;
1148 oc->proddables = pb;
1151 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1154 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1155 char* s = (char*)(pb->start);
1156 char* e = s + pb->size - 1;
1157 char* a = (char*)addr;
1158 /* Assumes that the biggest fixup involves a 4-byte write. This
1159 probably needs to be changed to 8 (ie, +7) on 64-bit
1161 if (a >= s && (a+3) <= e) return;
1163 barf("checkProddableBlock: invalid fixup in runtime linker");
1166 /* -----------------------------------------------------------------------------
1167 * Section management.
1169 static void addSection ( ObjectCode* oc, SectionKind kind,
1170 void* start, void* end )
1172 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1176 s->next = oc->sections;
1179 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1180 start, ((char*)end)-1, end - start + 1, kind );
1186 /* --------------------------------------------------------------------------
1187 * PEi386 specifics (Win32 targets)
1188 * ------------------------------------------------------------------------*/
1190 /* The information for this linker comes from
1191 Microsoft Portable Executable
1192 and Common Object File Format Specification
1193 revision 5.1 January 1998
1194 which SimonM says comes from the MS Developer Network CDs.
1196 It can be found there (on older CDs), but can also be found
1199 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1201 (this is Rev 6.0 from February 1999).
1203 Things move, so if that fails, try searching for it via
1205 http://www.google.com/search?q=PE+COFF+specification
1207 The ultimate reference for the PE format is the Winnt.h
1208 header file that comes with the Platform SDKs; as always,
1209 implementations will drift wrt their documentation.
1211 A good background article on the PE format is Matt Pietrek's
1212 March 1994 article in Microsoft System Journal (MSJ)
1213 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1214 Win32 Portable Executable File Format." The info in there
1215 has recently been updated in a two part article in
1216 MSDN magazine, issues Feb and March 2002,
1217 "Inside Windows: An In-Depth Look into the Win32 Portable
1218 Executable File Format"
1220 John Levine's book "Linkers and Loaders" contains useful
1225 #if defined(OBJFORMAT_PEi386)
1229 typedef unsigned char UChar;
1230 typedef unsigned short UInt16;
1231 typedef unsigned int UInt32;
1238 UInt16 NumberOfSections;
1239 UInt32 TimeDateStamp;
1240 UInt32 PointerToSymbolTable;
1241 UInt32 NumberOfSymbols;
1242 UInt16 SizeOfOptionalHeader;
1243 UInt16 Characteristics;
1247 #define sizeof_COFF_header 20
1254 UInt32 VirtualAddress;
1255 UInt32 SizeOfRawData;
1256 UInt32 PointerToRawData;
1257 UInt32 PointerToRelocations;
1258 UInt32 PointerToLinenumbers;
1259 UInt16 NumberOfRelocations;
1260 UInt16 NumberOfLineNumbers;
1261 UInt32 Characteristics;
1265 #define sizeof_COFF_section 40
1272 UInt16 SectionNumber;
1275 UChar NumberOfAuxSymbols;
1279 #define sizeof_COFF_symbol 18
1284 UInt32 VirtualAddress;
1285 UInt32 SymbolTableIndex;
1290 #define sizeof_COFF_reloc 10
1293 /* From PE spec doc, section 3.3.2 */
1294 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1295 windows.h -- for the same purpose, but I want to know what I'm
1297 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1298 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1299 #define MYIMAGE_FILE_DLL 0x2000
1300 #define MYIMAGE_FILE_SYSTEM 0x1000
1301 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1302 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1303 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1305 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1306 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1307 #define MYIMAGE_SYM_CLASS_STATIC 3
1308 #define MYIMAGE_SYM_UNDEFINED 0
1310 /* From PE spec doc, section 4.1 */
1311 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1312 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1313 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1315 /* From PE spec doc, section 5.2.1 */
1316 #define MYIMAGE_REL_I386_DIR32 0x0006
1317 #define MYIMAGE_REL_I386_REL32 0x0014
1320 /* We use myindex to calculate array addresses, rather than
1321 simply doing the normal subscript thing. That's because
1322 some of the above structs have sizes which are not
1323 a whole number of words. GCC rounds their sizes up to a
1324 whole number of words, which means that the address calcs
1325 arising from using normal C indexing or pointer arithmetic
1326 are just plain wrong. Sigh.
1329 myindex ( int scale, void* base, int index )
1332 ((UChar*)base) + scale * index;
1337 printName ( UChar* name, UChar* strtab )
1339 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1340 UInt32 strtab_offset = * (UInt32*)(name+4);
1341 fprintf ( stderr, "%s", strtab + strtab_offset );
1344 for (i = 0; i < 8; i++) {
1345 if (name[i] == 0) break;
1346 fprintf ( stderr, "%c", name[i] );
1353 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1355 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1356 UInt32 strtab_offset = * (UInt32*)(name+4);
1357 strncpy ( dst, strtab+strtab_offset, dstSize );
1363 if (name[i] == 0) break;
1373 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1376 /* If the string is longer than 8 bytes, look in the
1377 string table for it -- this will be correctly zero terminated.
1379 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1380 UInt32 strtab_offset = * (UInt32*)(name+4);
1381 return ((UChar*)strtab) + strtab_offset;
1383 /* Otherwise, if shorter than 8 bytes, return the original,
1384 which by defn is correctly terminated.
1386 if (name[7]==0) return name;
1387 /* The annoying case: 8 bytes. Copy into a temporary
1388 (which is never freed ...)
1390 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1392 strncpy(newstr,name,8);
1398 /* Just compares the short names (first 8 chars) */
1399 static COFF_section *
1400 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1404 = (COFF_header*)(oc->image);
1405 COFF_section* sectab
1407 ((UChar*)(oc->image))
1408 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1410 for (i = 0; i < hdr->NumberOfSections; i++) {
1413 COFF_section* section_i
1415 myindex ( sizeof_COFF_section, sectab, i );
1416 n1 = (UChar*) &(section_i->Name);
1418 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1419 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1420 n1[6]==n2[6] && n1[7]==n2[7])
1429 zapTrailingAtSign ( UChar* sym )
1431 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1433 if (sym[0] == 0) return;
1435 while (sym[i] != 0) i++;
1438 while (j > 0 && my_isdigit(sym[j])) j--;
1439 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1445 ocVerifyImage_PEi386 ( ObjectCode* oc )
1450 COFF_section* sectab;
1451 COFF_symbol* symtab;
1453 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1454 hdr = (COFF_header*)(oc->image);
1455 sectab = (COFF_section*) (
1456 ((UChar*)(oc->image))
1457 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1459 symtab = (COFF_symbol*) (
1460 ((UChar*)(oc->image))
1461 + hdr->PointerToSymbolTable
1463 strtab = ((UChar*)symtab)
1464 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1466 if (hdr->Machine != 0x14c) {
1467 belch("Not x86 PEi386");
1470 if (hdr->SizeOfOptionalHeader != 0) {
1471 belch("PEi386 with nonempty optional header");
1474 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1475 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1476 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1477 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1478 belch("Not a PEi386 object file");
1481 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1482 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1483 belch("Invalid PEi386 word size or endiannness: %d",
1484 (int)(hdr->Characteristics));
1487 /* If the string table size is way crazy, this might indicate that
1488 there are more than 64k relocations, despite claims to the
1489 contrary. Hence this test. */
1490 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1492 if ( (*(UInt32*)strtab) > 600000 ) {
1493 /* Note that 600k has no special significance other than being
1494 big enough to handle the almost-2MB-sized lumps that
1495 constitute HSwin32*.o. */
1496 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1501 /* No further verification after this point; only debug printing. */
1503 IF_DEBUG(linker, i=1);
1504 if (i == 0) return 1;
1507 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1509 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1511 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1513 fprintf ( stderr, "\n" );
1515 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1517 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1519 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1521 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1523 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1525 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1527 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1529 /* Print the section table. */
1530 fprintf ( stderr, "\n" );
1531 for (i = 0; i < hdr->NumberOfSections; i++) {
1533 COFF_section* sectab_i
1535 myindex ( sizeof_COFF_section, sectab, i );
1542 printName ( sectab_i->Name, strtab );
1552 sectab_i->VirtualSize,
1553 sectab_i->VirtualAddress,
1554 sectab_i->SizeOfRawData,
1555 sectab_i->PointerToRawData,
1556 sectab_i->NumberOfRelocations,
1557 sectab_i->PointerToRelocations,
1558 sectab_i->PointerToRawData
1560 reltab = (COFF_reloc*) (
1561 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1564 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1565 /* If the relocation field (a short) has overflowed, the
1566 * real count can be found in the first reloc entry.
1568 * See Section 4.1 (last para) of the PE spec (rev6.0).
1570 COFF_reloc* rel = (COFF_reloc*)
1571 myindex ( sizeof_COFF_reloc, reltab, 0 );
1572 noRelocs = rel->VirtualAddress;
1575 noRelocs = sectab_i->NumberOfRelocations;
1579 for (; j < noRelocs; j++) {
1581 COFF_reloc* rel = (COFF_reloc*)
1582 myindex ( sizeof_COFF_reloc, reltab, j );
1584 " type 0x%-4x vaddr 0x%-8x name `",
1586 rel->VirtualAddress );
1587 sym = (COFF_symbol*)
1588 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1589 /* Hmm..mysterious looking offset - what's it for? SOF */
1590 printName ( sym->Name, strtab -10 );
1591 fprintf ( stderr, "'\n" );
1594 fprintf ( stderr, "\n" );
1596 fprintf ( stderr, "\n" );
1597 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1598 fprintf ( stderr, "---START of string table---\n");
1599 for (i = 4; i < *(Int32*)strtab; i++) {
1601 fprintf ( stderr, "\n"); else
1602 fprintf( stderr, "%c", strtab[i] );
1604 fprintf ( stderr, "--- END of string table---\n");
1606 fprintf ( stderr, "\n" );
1609 COFF_symbol* symtab_i;
1610 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1611 symtab_i = (COFF_symbol*)
1612 myindex ( sizeof_COFF_symbol, symtab, i );
1618 printName ( symtab_i->Name, strtab );
1627 (Int32)(symtab_i->SectionNumber),
1628 (UInt32)symtab_i->Type,
1629 (UInt32)symtab_i->StorageClass,
1630 (UInt32)symtab_i->NumberOfAuxSymbols
1632 i += symtab_i->NumberOfAuxSymbols;
1636 fprintf ( stderr, "\n" );
1642 ocGetNames_PEi386 ( ObjectCode* oc )
1645 COFF_section* sectab;
1646 COFF_symbol* symtab;
1653 hdr = (COFF_header*)(oc->image);
1654 sectab = (COFF_section*) (
1655 ((UChar*)(oc->image))
1656 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1658 symtab = (COFF_symbol*) (
1659 ((UChar*)(oc->image))
1660 + hdr->PointerToSymbolTable
1662 strtab = ((UChar*)(oc->image))
1663 + hdr->PointerToSymbolTable
1664 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1666 /* Allocate space for any (local, anonymous) .bss sections. */
1668 for (i = 0; i < hdr->NumberOfSections; i++) {
1670 COFF_section* sectab_i
1672 myindex ( sizeof_COFF_section, sectab, i );
1673 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1674 if (sectab_i->VirtualSize == 0) continue;
1675 /* This is a non-empty .bss section. Allocate zeroed space for
1676 it, and set its PointerToRawData field such that oc->image +
1677 PointerToRawData == addr_of_zeroed_space. */
1678 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1679 "ocGetNames_PEi386(anonymous bss)");
1680 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1681 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1682 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1685 /* Copy section information into the ObjectCode. */
1687 for (i = 0; i < hdr->NumberOfSections; i++) {
1693 = SECTIONKIND_OTHER;
1694 COFF_section* sectab_i
1696 myindex ( sizeof_COFF_section, sectab, i );
1697 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1700 /* I'm sure this is the Right Way to do it. However, the
1701 alternative of testing the sectab_i->Name field seems to
1702 work ok with Cygwin.
1704 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1705 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1706 kind = SECTIONKIND_CODE_OR_RODATA;
1709 if (0==strcmp(".text",sectab_i->Name) ||
1710 0==strcmp(".rodata",sectab_i->Name))
1711 kind = SECTIONKIND_CODE_OR_RODATA;
1712 if (0==strcmp(".data",sectab_i->Name) ||
1713 0==strcmp(".bss",sectab_i->Name))
1714 kind = SECTIONKIND_RWDATA;
1716 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1717 sz = sectab_i->SizeOfRawData;
1718 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1720 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1721 end = start + sz - 1;
1723 if (kind == SECTIONKIND_OTHER
1724 /* Ignore sections called which contain stabs debugging
1726 && 0 != strcmp(".stab", sectab_i->Name)
1727 && 0 != strcmp(".stabstr", sectab_i->Name)
1729 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1733 if (kind != SECTIONKIND_OTHER && end >= start) {
1734 addSection(oc, kind, start, end);
1735 addProddableBlock(oc, start, end - start + 1);
1739 /* Copy exported symbols into the ObjectCode. */
1741 oc->n_symbols = hdr->NumberOfSymbols;
1742 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1743 "ocGetNames_PEi386(oc->symbols)");
1744 /* Call me paranoid; I don't care. */
1745 for (i = 0; i < oc->n_symbols; i++)
1746 oc->symbols[i] = NULL;
1750 COFF_symbol* symtab_i;
1751 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1752 symtab_i = (COFF_symbol*)
1753 myindex ( sizeof_COFF_symbol, symtab, i );
1757 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1758 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1759 /* This symbol is global and defined, viz, exported */
1760 /* for MYIMAGE_SYMCLASS_EXTERNAL
1761 && !MYIMAGE_SYM_UNDEFINED,
1762 the address of the symbol is:
1763 address of relevant section + offset in section
1765 COFF_section* sectabent
1766 = (COFF_section*) myindex ( sizeof_COFF_section,
1768 symtab_i->SectionNumber-1 );
1769 addr = ((UChar*)(oc->image))
1770 + (sectabent->PointerToRawData
1774 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1775 && symtab_i->Value > 0) {
1776 /* This symbol isn't in any section at all, ie, global bss.
1777 Allocate zeroed space for it. */
1778 addr = stgCallocBytes(1, symtab_i->Value,
1779 "ocGetNames_PEi386(non-anonymous bss)");
1780 addSection(oc, SECTIONKIND_RWDATA, addr,
1781 ((UChar*)addr) + symtab_i->Value - 1);
1782 addProddableBlock(oc, addr, symtab_i->Value);
1783 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1786 if (addr != NULL ) {
1787 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1788 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1789 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1790 ASSERT(i >= 0 && i < oc->n_symbols);
1791 /* cstring_from_COFF_symbol_name always succeeds. */
1792 oc->symbols[i] = sname;
1793 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1797 "IGNORING symbol %d\n"
1801 printName ( symtab_i->Name, strtab );
1810 (Int32)(symtab_i->SectionNumber),
1811 (UInt32)symtab_i->Type,
1812 (UInt32)symtab_i->StorageClass,
1813 (UInt32)symtab_i->NumberOfAuxSymbols
1818 i += symtab_i->NumberOfAuxSymbols;
1827 ocResolve_PEi386 ( ObjectCode* oc )
1830 COFF_section* sectab;
1831 COFF_symbol* symtab;
1841 /* ToDo: should be variable-sized? But is at least safe in the
1842 sense of buffer-overrun-proof. */
1844 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1846 hdr = (COFF_header*)(oc->image);
1847 sectab = (COFF_section*) (
1848 ((UChar*)(oc->image))
1849 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1851 symtab = (COFF_symbol*) (
1852 ((UChar*)(oc->image))
1853 + hdr->PointerToSymbolTable
1855 strtab = ((UChar*)(oc->image))
1856 + hdr->PointerToSymbolTable
1857 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1859 for (i = 0; i < hdr->NumberOfSections; i++) {
1860 COFF_section* sectab_i
1862 myindex ( sizeof_COFF_section, sectab, i );
1865 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1868 /* Ignore sections called which contain stabs debugging
1870 if (0 == strcmp(".stab", sectab_i->Name)
1871 || 0 == strcmp(".stabstr", sectab_i->Name))
1874 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1875 /* If the relocation field (a short) has overflowed, the
1876 * real count can be found in the first reloc entry.
1878 * See Section 4.1 (last para) of the PE spec (rev6.0).
1880 COFF_reloc* rel = (COFF_reloc*)
1881 myindex ( sizeof_COFF_reloc, reltab, 0 );
1882 noRelocs = rel->VirtualAddress;
1883 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1886 noRelocs = sectab_i->NumberOfRelocations;
1891 for (; j < noRelocs; j++) {
1893 COFF_reloc* reltab_j
1895 myindex ( sizeof_COFF_reloc, reltab, j );
1897 /* the location to patch */
1899 ((UChar*)(oc->image))
1900 + (sectab_i->PointerToRawData
1901 + reltab_j->VirtualAddress
1902 - sectab_i->VirtualAddress )
1904 /* the existing contents of pP */
1906 /* the symbol to connect to */
1907 sym = (COFF_symbol*)
1908 myindex ( sizeof_COFF_symbol,
1909 symtab, reltab_j->SymbolTableIndex );
1912 "reloc sec %2d num %3d: type 0x%-4x "
1913 "vaddr 0x%-8x name `",
1915 (UInt32)reltab_j->Type,
1916 reltab_j->VirtualAddress );
1917 printName ( sym->Name, strtab );
1918 fprintf ( stderr, "'\n" ));
1920 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1921 COFF_section* section_sym
1922 = findPEi386SectionCalled ( oc, sym->Name );
1924 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1927 S = ((UInt32)(oc->image))
1928 + (section_sym->PointerToRawData
1931 copyName ( sym->Name, strtab, symbol, 1000-1 );
1932 (void*)S = lookupLocalSymbol( oc, symbol );
1933 if ((void*)S != NULL) goto foundit;
1934 (void*)S = lookupSymbol( symbol );
1935 if ((void*)S != NULL) goto foundit;
1936 zapTrailingAtSign ( symbol );
1937 (void*)S = lookupLocalSymbol( oc, symbol );
1938 if ((void*)S != NULL) goto foundit;
1939 (void*)S = lookupSymbol( symbol );
1940 if ((void*)S != NULL) goto foundit;
1941 /* Newline first because the interactive linker has printed "linking..." */
1942 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1946 checkProddableBlock(oc, pP);
1947 switch (reltab_j->Type) {
1948 case MYIMAGE_REL_I386_DIR32:
1951 case MYIMAGE_REL_I386_REL32:
1952 /* Tricky. We have to insert a displacement at
1953 pP which, when added to the PC for the _next_
1954 insn, gives the address of the target (S).
1955 Problem is to know the address of the next insn
1956 when we only know pP. We assume that this
1957 literal field is always the last in the insn,
1958 so that the address of the next insn is pP+4
1959 -- hence the constant 4.
1960 Also I don't know if A should be added, but so
1961 far it has always been zero.
1964 *pP = S - ((UInt32)pP) - 4;
1967 belch("%s: unhandled PEi386 relocation type %d",
1968 oc->fileName, reltab_j->Type);
1975 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1979 #endif /* defined(OBJFORMAT_PEi386) */
1982 /* --------------------------------------------------------------------------
1984 * ------------------------------------------------------------------------*/
1986 #if defined(OBJFORMAT_ELF)
1991 #if defined(sparc_TARGET_ARCH)
1992 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
1993 #elif defined(i386_TARGET_ARCH)
1994 # define ELF_TARGET_386 /* Used inside <elf.h> */
1995 #elif defined (ia64_TARGET_ARCH)
1996 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
1998 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
1999 # define ELF_NEED_GOT /* needs Global Offset Table */
2000 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2006 * Define a set of types which can be used for both ELF32 and ELF64
2010 #define ELFCLASS ELFCLASS64
2011 #define Elf_Addr Elf64_Addr
2012 #define Elf_Word Elf64_Word
2013 #define Elf_Sword Elf64_Sword
2014 #define Elf_Ehdr Elf64_Ehdr
2015 #define Elf_Phdr Elf64_Phdr
2016 #define Elf_Shdr Elf64_Shdr
2017 #define Elf_Sym Elf64_Sym
2018 #define Elf_Rel Elf64_Rel
2019 #define Elf_Rela Elf64_Rela
2020 #define ELF_ST_TYPE ELF64_ST_TYPE
2021 #define ELF_ST_BIND ELF64_ST_BIND
2022 #define ELF_R_TYPE ELF64_R_TYPE
2023 #define ELF_R_SYM ELF64_R_SYM
2025 #define ELFCLASS ELFCLASS32
2026 #define Elf_Addr Elf32_Addr
2027 #define Elf_Word Elf32_Word
2028 #define Elf_Sword Elf32_Sword
2029 #define Elf_Ehdr Elf32_Ehdr
2030 #define Elf_Phdr Elf32_Phdr
2031 #define Elf_Shdr Elf32_Shdr
2032 #define Elf_Sym Elf32_Sym
2033 #define Elf_Rel Elf32_Rel
2034 #define Elf_Rela Elf32_Rela
2035 #define ELF_ST_TYPE ELF32_ST_TYPE
2036 #define ELF_ST_BIND ELF32_ST_BIND
2037 #define ELF_R_TYPE ELF32_R_TYPE
2038 #define ELF_R_SYM ELF32_R_SYM
2043 * Functions to allocate entries in dynamic sections. Currently we simply
2044 * preallocate a large number, and we don't check if a entry for the given
2045 * target already exists (a linear search is too slow). Ideally these
2046 * entries would be associated with symbols.
2049 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2050 #define GOT_SIZE 0x20000
2051 #define FUNCTION_TABLE_SIZE 0x10000
2052 #define PLT_SIZE 0x08000
2055 static Elf_Addr got[GOT_SIZE];
2056 static unsigned int gotIndex;
2057 static Elf_Addr gp_val = (Elf_Addr)got;
2060 allocateGOTEntry(Elf_Addr target)
2064 if (gotIndex >= GOT_SIZE)
2065 barf("Global offset table overflow");
2067 entry = &got[gotIndex++];
2069 return (Elf_Addr)entry;
2073 #ifdef ELF_FUNCTION_DESC
2079 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2080 static unsigned int functionTableIndex;
2083 allocateFunctionDesc(Elf_Addr target)
2085 FunctionDesc *entry;
2087 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2088 barf("Function table overflow");
2090 entry = &functionTable[functionTableIndex++];
2092 entry->gp = (Elf_Addr)gp_val;
2093 return (Elf_Addr)entry;
2097 copyFunctionDesc(Elf_Addr target)
2099 FunctionDesc *olddesc = (FunctionDesc *)target;
2100 FunctionDesc *newdesc;
2102 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2103 newdesc->gp = olddesc->gp;
2104 return (Elf_Addr)newdesc;
2109 #ifdef ia64_TARGET_ARCH
2110 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2111 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2113 static unsigned char plt_code[] =
2115 /* taken from binutils bfd/elfxx-ia64.c */
2116 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2117 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2118 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2119 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2120 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2121 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2124 /* If we can't get to the function descriptor via gp, take a local copy of it */
2125 #define PLT_RELOC(code, target) { \
2126 Elf64_Sxword rel_value = target - gp_val; \
2127 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2128 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2130 ia64_reloc_gprel22((Elf_Addr)code, target); \
2135 unsigned char code[sizeof(plt_code)];
2139 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2141 PLTEntry *plt = (PLTEntry *)oc->plt;
2144 if (oc->pltIndex >= PLT_SIZE)
2145 barf("Procedure table overflow");
2147 entry = &plt[oc->pltIndex++];
2148 memcpy(entry->code, plt_code, sizeof(entry->code));
2149 PLT_RELOC(entry->code, target);
2150 return (Elf_Addr)entry;
2156 return (PLT_SIZE * sizeof(PLTEntry));
2162 * Generic ELF functions
2166 findElfSection ( void* objImage, Elf_Word sh_type )
2168 char* ehdrC = (char*)objImage;
2169 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2170 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2171 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2175 for (i = 0; i < ehdr->e_shnum; i++) {
2176 if (shdr[i].sh_type == sh_type
2177 /* Ignore the section header's string table. */
2178 && i != ehdr->e_shstrndx
2179 /* Ignore string tables named .stabstr, as they contain
2181 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2183 ptr = ehdrC + shdr[i].sh_offset;
2190 #if defined(ia64_TARGET_ARCH)
2192 findElfSegment ( void* objImage, Elf_Addr vaddr )
2194 char* ehdrC = (char*)objImage;
2195 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2196 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2197 Elf_Addr segaddr = 0;
2200 for (i = 0; i < ehdr->e_phnum; i++) {
2201 segaddr = phdr[i].p_vaddr;
2202 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2210 ocVerifyImage_ELF ( ObjectCode* oc )
2214 int i, j, nent, nstrtab, nsymtabs;
2218 char* ehdrC = (char*)(oc->image);
2219 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2221 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2222 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2223 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2224 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2225 belch("%s: not an ELF object", oc->fileName);
2229 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2230 belch("%s: unsupported ELF format", oc->fileName);
2234 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2235 IF_DEBUG(linker,belch( "Is little-endian" ));
2237 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2238 IF_DEBUG(linker,belch( "Is big-endian" ));
2240 belch("%s: unknown endiannness", oc->fileName);
2244 if (ehdr->e_type != ET_REL) {
2245 belch("%s: not a relocatable object (.o) file", oc->fileName);
2248 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2250 IF_DEBUG(linker,belch( "Architecture is " ));
2251 switch (ehdr->e_machine) {
2252 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2253 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2255 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2257 default: IF_DEBUG(linker,belch( "unknown" ));
2258 belch("%s: unknown architecture", oc->fileName);
2262 IF_DEBUG(linker,belch(
2263 "\nSection header table: start %d, n_entries %d, ent_size %d",
2264 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2266 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2268 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2270 if (ehdr->e_shstrndx == SHN_UNDEF) {
2271 belch("%s: no section header string table", oc->fileName);
2274 IF_DEBUG(linker,belch( "Section header string table is section %d",
2276 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2279 for (i = 0; i < ehdr->e_shnum; i++) {
2280 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2281 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2282 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2283 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2284 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2285 ehdrC + shdr[i].sh_offset,
2286 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2288 if (shdr[i].sh_type == SHT_REL) {
2289 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2290 } else if (shdr[i].sh_type == SHT_RELA) {
2291 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2293 IF_DEBUG(linker,fprintf(stderr," "));
2296 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2300 IF_DEBUG(linker,belch( "\nString tables" ));
2303 for (i = 0; i < ehdr->e_shnum; i++) {
2304 if (shdr[i].sh_type == SHT_STRTAB
2305 /* Ignore the section header's string table. */
2306 && i != ehdr->e_shstrndx
2307 /* Ignore string tables named .stabstr, as they contain
2309 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2311 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2312 strtab = ehdrC + shdr[i].sh_offset;
2317 belch("%s: no string tables, or too many", oc->fileName);
2322 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2323 for (i = 0; i < ehdr->e_shnum; i++) {
2324 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2325 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2327 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2328 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2329 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2331 shdr[i].sh_size % sizeof(Elf_Sym)
2333 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2334 belch("%s: non-integral number of symbol table entries", oc->fileName);
2337 for (j = 0; j < nent; j++) {
2338 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2339 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2340 (int)stab[j].st_shndx,
2341 (int)stab[j].st_size,
2342 (char*)stab[j].st_value ));
2344 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2345 switch (ELF_ST_TYPE(stab[j].st_info)) {
2346 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2347 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2348 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2349 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2350 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2351 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2353 IF_DEBUG(linker,fprintf(stderr, " " ));
2355 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2356 switch (ELF_ST_BIND(stab[j].st_info)) {
2357 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2358 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2359 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2360 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2362 IF_DEBUG(linker,fprintf(stderr, " " ));
2364 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2368 if (nsymtabs == 0) {
2369 belch("%s: didn't find any symbol tables", oc->fileName);
2378 ocGetNames_ELF ( ObjectCode* oc )
2383 char* ehdrC = (char*)(oc->image);
2384 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2385 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2386 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2388 ASSERT(symhash != NULL);
2391 belch("%s: no strtab", oc->fileName);
2396 for (i = 0; i < ehdr->e_shnum; i++) {
2397 /* Figure out what kind of section it is. Logic derived from
2398 Figure 1.14 ("Special Sections") of the ELF document
2399 ("Portable Formats Specification, Version 1.1"). */
2400 Elf_Shdr hdr = shdr[i];
2401 SectionKind kind = SECTIONKIND_OTHER;
2404 if (hdr.sh_type == SHT_PROGBITS
2405 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2406 /* .text-style section */
2407 kind = SECTIONKIND_CODE_OR_RODATA;
2410 if (hdr.sh_type == SHT_PROGBITS
2411 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2412 /* .data-style section */
2413 kind = SECTIONKIND_RWDATA;
2416 if (hdr.sh_type == SHT_PROGBITS
2417 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2418 /* .rodata-style section */
2419 kind = SECTIONKIND_CODE_OR_RODATA;
2422 if (hdr.sh_type == SHT_NOBITS
2423 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2424 /* .bss-style section */
2425 kind = SECTIONKIND_RWDATA;
2429 if (is_bss && shdr[i].sh_size > 0) {
2430 /* This is a non-empty .bss section. Allocate zeroed space for
2431 it, and set its .sh_offset field such that
2432 ehdrC + .sh_offset == addr_of_zeroed_space. */
2433 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2434 "ocGetNames_ELF(BSS)");
2435 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2437 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2438 zspace, shdr[i].sh_size);
2442 /* fill in the section info */
2443 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2444 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2445 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2446 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2449 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2451 /* copy stuff into this module's object symbol table */
2452 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2453 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2455 oc->n_symbols = nent;
2456 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2457 "ocGetNames_ELF(oc->symbols)");
2459 for (j = 0; j < nent; j++) {
2461 char isLocal = FALSE; /* avoids uninit-var warning */
2463 char* nm = strtab + stab[j].st_name;
2464 int secno = stab[j].st_shndx;
2466 /* Figure out if we want to add it; if so, set ad to its
2467 address. Otherwise leave ad == NULL. */
2469 if (secno == SHN_COMMON) {
2471 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2473 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2474 stab[j].st_size, nm);
2476 /* Pointless to do addProddableBlock() for this area,
2477 since the linker should never poke around in it. */
2480 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2481 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2483 /* and not an undefined symbol */
2484 && stab[j].st_shndx != SHN_UNDEF
2485 /* and not in a "special section" */
2486 && stab[j].st_shndx < SHN_LORESERVE
2488 /* and it's a not a section or string table or anything silly */
2489 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2490 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2491 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2494 /* Section 0 is the undefined section, hence > and not >=. */
2495 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2497 if (shdr[secno].sh_type == SHT_NOBITS) {
2498 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2499 stab[j].st_size, stab[j].st_value, nm);
2502 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2503 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2506 #ifdef ELF_FUNCTION_DESC
2507 /* dlsym() and the initialisation table both give us function
2508 * descriptors, so to be consistent we store function descriptors
2509 * in the symbol table */
2510 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2511 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2513 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2514 ad, oc->fileName, nm ));
2519 /* And the decision is ... */
2523 oc->symbols[j] = nm;
2526 /* Ignore entirely. */
2528 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2532 IF_DEBUG(linker,belch( "skipping `%s'",
2533 strtab + stab[j].st_name ));
2536 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2537 (int)ELF_ST_BIND(stab[j].st_info),
2538 (int)ELF_ST_TYPE(stab[j].st_info),
2539 (int)stab[j].st_shndx,
2540 strtab + stab[j].st_name
2543 oc->symbols[j] = NULL;
2552 /* Do ELF relocations which lack an explicit addend. All x86-linux
2553 relocations appear to be of this form. */
2555 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2556 Elf_Shdr* shdr, int shnum,
2557 Elf_Sym* stab, char* strtab )
2562 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2563 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2564 int target_shndx = shdr[shnum].sh_info;
2565 int symtab_shndx = shdr[shnum].sh_link;
2567 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2568 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2569 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2570 target_shndx, symtab_shndx ));
2572 for (j = 0; j < nent; j++) {
2573 Elf_Addr offset = rtab[j].r_offset;
2574 Elf_Addr info = rtab[j].r_info;
2576 Elf_Addr P = ((Elf_Addr)targ) + offset;
2577 Elf_Word* pP = (Elf_Word*)P;
2582 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2583 j, (void*)offset, (void*)info ));
2585 IF_DEBUG(linker,belch( " ZERO" ));
2588 Elf_Sym sym = stab[ELF_R_SYM(info)];
2589 /* First see if it is a local symbol. */
2590 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2591 /* Yes, so we can get the address directly from the ELF symbol
2593 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2595 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2596 + stab[ELF_R_SYM(info)].st_value);
2599 /* No, so look up the name in our global table. */
2600 symbol = strtab + sym.st_name;
2601 (void*)S = lookupSymbol( symbol );
2604 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2607 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2610 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2611 (void*)P, (void*)S, (void*)A ));
2612 checkProddableBlock ( oc, pP );
2616 switch (ELF_R_TYPE(info)) {
2617 # ifdef i386_TARGET_ARCH
2618 case R_386_32: *pP = value; break;
2619 case R_386_PC32: *pP = value - P; break;
2622 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2623 oc->fileName, ELF_R_TYPE(info));
2631 /* Do ELF relocations for which explicit addends are supplied.
2632 sparc-solaris relocations appear to be of this form. */
2634 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2635 Elf_Shdr* shdr, int shnum,
2636 Elf_Sym* stab, char* strtab )
2641 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2642 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2643 int target_shndx = shdr[shnum].sh_info;
2644 int symtab_shndx = shdr[shnum].sh_link;
2646 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2647 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2648 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2649 target_shndx, symtab_shndx ));
2651 for (j = 0; j < nent; j++) {
2652 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2653 /* This #ifdef only serves to avoid unused-var warnings. */
2654 Elf_Addr offset = rtab[j].r_offset;
2655 Elf_Addr P = targ + offset;
2657 Elf_Addr info = rtab[j].r_info;
2658 Elf_Addr A = rtab[j].r_addend;
2661 # if defined(sparc_TARGET_ARCH)
2662 Elf_Word* pP = (Elf_Word*)P;
2664 # elif defined(ia64_TARGET_ARCH)
2665 Elf64_Xword *pP = (Elf64_Xword *)P;
2669 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2670 j, (void*)offset, (void*)info,
2673 IF_DEBUG(linker,belch( " ZERO" ));
2676 Elf_Sym sym = stab[ELF_R_SYM(info)];
2677 /* First see if it is a local symbol. */
2678 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2679 /* Yes, so we can get the address directly from the ELF symbol
2681 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2683 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2684 + stab[ELF_R_SYM(info)].st_value);
2685 #ifdef ELF_FUNCTION_DESC
2686 /* Make a function descriptor for this function */
2687 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2688 S = allocateFunctionDesc(S + A);
2693 /* No, so look up the name in our global table. */
2694 symbol = strtab + sym.st_name;
2695 (void*)S = lookupSymbol( symbol );
2697 #ifdef ELF_FUNCTION_DESC
2698 /* If a function, already a function descriptor - we would
2699 have to copy it to add an offset. */
2700 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2705 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2708 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2711 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2712 (void*)P, (void*)S, (void*)A ));
2713 /* checkProddableBlock ( oc, (void*)P ); */
2717 switch (ELF_R_TYPE(info)) {
2718 # if defined(sparc_TARGET_ARCH)
2719 case R_SPARC_WDISP30:
2720 w1 = *pP & 0xC0000000;
2721 w2 = (Elf_Word)((value - P) >> 2);
2722 ASSERT((w2 & 0xC0000000) == 0);
2727 w1 = *pP & 0xFFC00000;
2728 w2 = (Elf_Word)(value >> 10);
2729 ASSERT((w2 & 0xFFC00000) == 0);
2735 w2 = (Elf_Word)(value & 0x3FF);
2736 ASSERT((w2 & ~0x3FF) == 0);
2740 /* According to the Sun documentation:
2742 This relocation type resembles R_SPARC_32, except it refers to an
2743 unaligned word. That is, the word to be relocated must be treated
2744 as four separate bytes with arbitrary alignment, not as a word
2745 aligned according to the architecture requirements.
2747 (JRS: which means that freeloading on the R_SPARC_32 case
2748 is probably wrong, but hey ...)
2752 w2 = (Elf_Word)value;
2755 # elif defined(ia64_TARGET_ARCH)
2756 case R_IA64_DIR64LSB:
2757 case R_IA64_FPTR64LSB:
2760 case R_IA64_SEGREL64LSB:
2761 addr = findElfSegment(ehdrC, value);
2764 case R_IA64_GPREL22:
2765 ia64_reloc_gprel22(P, value);
2767 case R_IA64_LTOFF22:
2768 case R_IA64_LTOFF_FPTR22:
2769 addr = allocateGOTEntry(value);
2770 ia64_reloc_gprel22(P, addr);
2772 case R_IA64_PCREL21B:
2773 ia64_reloc_pcrel21(P, S, oc);
2777 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2778 oc->fileName, ELF_R_TYPE(info));
2787 ocResolve_ELF ( ObjectCode* oc )
2791 Elf_Sym* stab = NULL;
2792 char* ehdrC = (char*)(oc->image);
2793 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2794 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2795 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2797 /* first find "the" symbol table */
2798 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2800 /* also go find the string table */
2801 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2803 if (stab == NULL || strtab == NULL) {
2804 belch("%s: can't find string or symbol table", oc->fileName);
2808 /* Process the relocation sections. */
2809 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2811 /* Skip sections called ".rel.stab". These appear to contain
2812 relocation entries that, when done, make the stabs debugging
2813 info point at the right places. We ain't interested in all
2815 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2818 if (shdr[shnum].sh_type == SHT_REL ) {
2819 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2820 shnum, stab, strtab );
2824 if (shdr[shnum].sh_type == SHT_RELA) {
2825 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2826 shnum, stab, strtab );
2831 /* Free the local symbol table; we won't need it again. */
2832 freeHashTable(oc->lochash, NULL);
2840 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2841 * at the front. The following utility functions pack and unpack instructions, and
2842 * take care of the most common relocations.
2845 #ifdef ia64_TARGET_ARCH
2848 ia64_extract_instruction(Elf64_Xword *target)
2851 int slot = (Elf_Addr)target & 3;
2852 (Elf_Addr)target &= ~3;
2860 return ((w1 >> 5) & 0x1ffffffffff);
2862 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2866 barf("ia64_extract_instruction: invalid slot %p", target);
2871 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2873 int slot = (Elf_Addr)target & 3;
2874 (Elf_Addr)target &= ~3;
2879 *target |= value << 5;
2882 *target |= value << 46;
2883 *(target+1) |= value >> 18;
2886 *(target+1) |= value << 23;
2892 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2894 Elf64_Xword instruction;
2895 Elf64_Sxword rel_value;
2897 rel_value = value - gp_val;
2898 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2899 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2901 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2902 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2903 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2904 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2905 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2906 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2910 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2912 Elf64_Xword instruction;
2913 Elf64_Sxword rel_value;
2916 entry = allocatePLTEntry(value, oc);
2918 rel_value = (entry >> 4) - (target >> 4);
2919 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2920 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2922 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2923 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2924 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2925 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2932 /* --------------------------------------------------------------------------
2934 * ------------------------------------------------------------------------*/
2936 #if defined(OBJFORMAT_MACHO)
2939 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2940 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2942 I hereby formally apologize for the hackish nature of this code.
2943 Things that need to be done:
2944 *) get common symbols and .bss sections to work properly.
2945 Haskell modules seem to work, but C modules can cause problems
2946 *) implement ocVerifyImage_MachO
2947 *) add more sanity checks. The current code just has to segfault if there's a
2951 static int ocVerifyImage_MachO(ObjectCode* oc)
2953 // FIXME: do some verifying here
2957 static int resolveImports(
2960 struct symtab_command *symLC,
2961 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2962 unsigned long *indirectSyms,
2963 struct nlist *nlist)
2967 for(i=0;i*4<sect->size;i++)
2969 // according to otool, reserved1 contains the first index into the indirect symbol table
2970 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2971 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2974 if((symbol->n_type & N_TYPE) == N_UNDF
2975 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
2976 addr = (void*) (symbol->n_value);
2977 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
2980 addr = lookupSymbol(nm);
2983 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
2987 ((void**)(image + sect->offset))[i] = addr;
2993 static int relocateSection(char *image,
2994 struct symtab_command *symLC, struct nlist *nlist,
2995 struct section* sections, struct section *sect)
2997 struct relocation_info *relocs;
3000 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3002 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3006 relocs = (struct relocation_info*) (image + sect->reloff);
3010 if(relocs[i].r_address & R_SCATTERED)
3012 struct scattered_relocation_info *scat =
3013 (struct scattered_relocation_info*) &relocs[i];
3017 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3019 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3021 *word = scat->r_value + sect->offset + ((long) image);
3025 continue; // FIXME: I hope it's OK to ignore all the others.
3029 struct relocation_info *reloc = &relocs[i];
3030 if(reloc->r_pcrel && !reloc->r_extern)
3033 if(reloc->r_length == 2)
3035 unsigned long word = 0;
3037 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3039 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3043 else if(reloc->r_type == PPC_RELOC_LO16)
3045 word = ((unsigned short*) wordPtr)[1];
3046 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3048 else if(reloc->r_type == PPC_RELOC_HI16)
3050 word = ((unsigned short*) wordPtr)[1] << 16;
3051 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3053 else if(reloc->r_type == PPC_RELOC_HA16)
3055 word = ((unsigned short*) wordPtr)[1] << 16;
3056 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3058 else if(reloc->r_type == PPC_RELOC_BR24)
3061 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3065 if(!reloc->r_extern)
3068 sections[reloc->r_symbolnum-1].offset
3069 - sections[reloc->r_symbolnum-1].addr
3076 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3077 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3078 word = (unsigned long) (lookupSymbol(nm));
3081 belch("\nunknown symbol `%s'", nm);
3086 word -= ((long)image) + sect->offset + reloc->r_address;
3089 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3094 else if(reloc->r_type == PPC_RELOC_LO16)
3096 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3099 else if(reloc->r_type == PPC_RELOC_HI16)
3101 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3104 else if(reloc->r_type == PPC_RELOC_HA16)
3106 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3107 + ((word & (1<<15)) ? 1 : 0);
3110 else if(reloc->r_type == PPC_RELOC_BR24)
3112 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3116 barf("\nunknown relocation %d",reloc->r_type);
3123 static int ocGetNames_MachO(ObjectCode* oc)
3125 char *image = (char*) oc->image;
3126 struct mach_header *header = (struct mach_header*) image;
3127 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3128 unsigned i,curSymbol;
3129 struct segment_command *segLC = NULL;
3130 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3131 struct symtab_command *symLC = NULL;
3132 struct dysymtab_command *dsymLC = NULL;
3133 struct nlist *nlist;
3134 unsigned long commonSize = 0;
3135 char *commonStorage = NULL;
3136 unsigned long commonCounter;
3138 for(i=0;i<header->ncmds;i++)
3140 if(lc->cmd == LC_SEGMENT)
3141 segLC = (struct segment_command*) lc;
3142 else if(lc->cmd == LC_SYMTAB)
3143 symLC = (struct symtab_command*) lc;
3144 else if(lc->cmd == LC_DYSYMTAB)
3145 dsymLC = (struct dysymtab_command*) lc;
3146 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3149 sections = (struct section*) (segLC+1);
3150 nlist = (struct nlist*) (image + symLC->symoff);
3152 for(i=0;i<segLC->nsects;i++)
3154 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3155 la_ptrs = §ions[i];
3156 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3157 nl_ptrs = §ions[i];
3159 // for now, only add __text and __const to the sections table
3160 else if(!strcmp(sections[i].sectname,"__text"))
3161 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3162 (void*) (image + sections[i].offset),
3163 (void*) (image + sections[i].offset + sections[i].size));
3164 else if(!strcmp(sections[i].sectname,"__const"))
3165 addSection(oc, SECTIONKIND_RWDATA,
3166 (void*) (image + sections[i].offset),
3167 (void*) (image + sections[i].offset + sections[i].size));
3168 else if(!strcmp(sections[i].sectname,"__data"))
3169 addSection(oc, SECTIONKIND_RWDATA,
3170 (void*) (image + sections[i].offset),
3171 (void*) (image + sections[i].offset + sections[i].size));
3174 // count external symbols defined here
3176 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3178 if((nlist[i].n_type & N_TYPE) == N_SECT)
3181 for(i=0;i<symLC->nsyms;i++)
3183 if((nlist[i].n_type & N_TYPE) == N_UNDF
3184 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3186 commonSize += nlist[i].n_value;
3190 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3191 "ocGetNames_MachO(oc->symbols)");
3193 // insert symbols into hash table
3194 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3196 if((nlist[i].n_type & N_TYPE) == N_SECT)
3198 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3199 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3200 sections[nlist[i].n_sect-1].offset
3201 - sections[nlist[i].n_sect-1].addr
3202 + nlist[i].n_value);
3203 oc->symbols[curSymbol++] = nm;
3207 // insert local symbols into lochash
3208 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3210 if((nlist[i].n_type & N_TYPE) == N_SECT)
3212 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3213 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3214 sections[nlist[i].n_sect-1].offset
3215 - sections[nlist[i].n_sect-1].addr
3216 + nlist[i].n_value);
3221 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3222 commonCounter = (unsigned long)commonStorage;
3223 for(i=0;i<symLC->nsyms;i++)
3225 if((nlist[i].n_type & N_TYPE) == N_UNDF
3226 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3228 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3229 unsigned long sz = nlist[i].n_value;
3231 nlist[i].n_value = commonCounter;
3233 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3234 oc->symbols[curSymbol++] = nm;
3236 commonCounter += sz;
3242 static int ocResolve_MachO(ObjectCode* oc)
3244 char *image = (char*) oc->image;
3245 struct mach_header *header = (struct mach_header*) image;
3246 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3248 struct segment_command *segLC = NULL;
3249 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3250 struct symtab_command *symLC = NULL;
3251 struct dysymtab_command *dsymLC = NULL;
3252 struct nlist *nlist;
3253 unsigned long *indirectSyms;
3255 for(i=0;i<header->ncmds;i++)
3257 if(lc->cmd == LC_SEGMENT)
3258 segLC = (struct segment_command*) lc;
3259 else if(lc->cmd == LC_SYMTAB)
3260 symLC = (struct symtab_command*) lc;
3261 else if(lc->cmd == LC_DYSYMTAB)
3262 dsymLC = (struct dysymtab_command*) lc;
3263 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3266 sections = (struct section*) (segLC+1);
3267 nlist = (struct nlist*) (image + symLC->symoff);
3269 for(i=0;i<segLC->nsects;i++)
3271 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3272 la_ptrs = §ions[i];
3273 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3274 nl_ptrs = §ions[i];
3277 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3280 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3283 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3286 for(i=0;i<segLC->nsects;i++)
3288 if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
3292 /* Free the local symbol table; we won't need it again. */
3293 freeHashTable(oc->lochash, NULL);
3299 * The Mach-O object format uses leading underscores. But not everywhere.
3300 * There is a small number of runtime support functions defined in
3301 * libcc_dynamic.a whose name does not have a leading underscore.
3302 * As a consequence, we can't get their address from C code.
3303 * We have to use inline assembler just to take the address of a function.
3307 static void machoInitSymbolsWithoutUnderscore()
3313 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3314 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3316 RTS_MACHO_NOUNDERLINE_SYMBOLS