1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.120 2003/05/30 09:06:24 simonmar Exp $
4 * (c) The GHC Team, 2000-2003
8 * ---------------------------------------------------------------------------*/
11 #include "PosixSource.h"
18 #include "LinkerInternals.h"
20 #include "StoragePriv.h"
23 #ifdef HAVE_SYS_TYPES_H
24 #include <sys/types.h>
30 #ifdef HAVE_SYS_STAT_H
34 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
35 #include <HaskellSupport/dlfcn.h>
36 #elif defined(HAVE_DLFCN_H)
40 #if defined(cygwin32_TARGET_OS)
45 #ifdef HAVE_SYS_TIME_H
49 #include <sys/fcntl.h>
50 #include <sys/termios.h>
51 #include <sys/utime.h>
52 #include <sys/utsname.h>
56 #if defined(ia64_TARGET_ARCH)
62 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS)
63 # define OBJFORMAT_ELF
64 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
65 # define OBJFORMAT_PEi386
68 #elif defined(darwin_TARGET_OS)
69 # include <mach-o/ppc/reloc.h>
70 # define OBJFORMAT_MACHO
71 # include <mach-o/loader.h>
72 # include <mach-o/nlist.h>
73 # include <mach-o/reloc.h>
76 /* Hash table mapping symbol names to Symbol */
77 static /*Str*/HashTable *symhash;
79 /* List of currently loaded objects */
80 ObjectCode *objects = NULL; /* initially empty */
82 #if defined(OBJFORMAT_ELF)
83 static int ocVerifyImage_ELF ( ObjectCode* oc );
84 static int ocGetNames_ELF ( ObjectCode* oc );
85 static int ocResolve_ELF ( ObjectCode* oc );
86 #elif defined(OBJFORMAT_PEi386)
87 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
88 static int ocGetNames_PEi386 ( ObjectCode* oc );
89 static int ocResolve_PEi386 ( ObjectCode* oc );
90 #elif defined(OBJFORMAT_MACHO)
91 static int ocVerifyImage_MachO ( ObjectCode* oc );
92 static int ocGetNames_MachO ( ObjectCode* oc );
93 static int ocResolve_MachO ( ObjectCode* oc );
95 static void machoInitSymbolsWithoutUnderscore( void );
98 /* -----------------------------------------------------------------------------
99 * Built-in symbols from the RTS
102 typedef struct _RtsSymbolVal {
109 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
111 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
112 SymX(makeStableNamezh_fast) \
113 SymX(finalizzeWeakzh_fast)
115 /* These are not available in GUM!!! -- HWL */
116 #define Maybe_ForeignObj
117 #define Maybe_Stable_Names
120 #if !defined (mingw32_TARGET_OS)
121 #define RTS_POSIX_ONLY_SYMBOLS \
122 SymX(stg_sig_install) \
126 #if defined (cygwin32_TARGET_OS)
127 #define RTS_MINGW_ONLY_SYMBOLS /**/
128 /* Don't have the ability to read import libs / archives, so
129 * we have to stupidly list a lot of what libcygwin.a
132 #define RTS_CYGWIN_ONLY_SYMBOLS \
210 #elif !defined(mingw32_TARGET_OS)
211 #define RTS_MINGW_ONLY_SYMBOLS /**/
212 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
213 #else /* defined(mingw32_TARGET_OS) */
214 #define RTS_POSIX_ONLY_SYMBOLS /**/
215 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
217 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
219 #define RTS_MINGW_EXTRA_SYMS \
220 Sym(_imp____mb_cur_max) \
223 #define RTS_MINGW_EXTRA_SYMS
226 /* These are statically linked from the mingw libraries into the ghc
227 executable, so we have to employ this hack. */
228 #define RTS_MINGW_ONLY_SYMBOLS \
229 SymX(asyncReadzh_fast) \
230 SymX(asyncWritezh_fast) \
242 SymX(getservbyname) \
243 SymX(getservbyport) \
244 SymX(getprotobynumber) \
245 SymX(getprotobyname) \
246 SymX(gethostbyname) \
247 SymX(gethostbyaddr) \
282 Sym(_imp___timezone) \
290 RTS_MINGW_EXTRA_SYMS \
295 # define MAIN_CAP_SYM SymX(MainCapability)
297 # define MAIN_CAP_SYM
300 #define RTS_SYMBOLS \
304 SymX(stg_enter_info) \
305 SymX(stg_enter_ret) \
306 SymX(stg_gc_void_info) \
307 SymX(__stg_gc_enter_1) \
308 SymX(stg_gc_noregs) \
309 SymX(stg_gc_unpt_r1_info) \
310 SymX(stg_gc_unpt_r1) \
311 SymX(stg_gc_unbx_r1_info) \
312 SymX(stg_gc_unbx_r1) \
313 SymX(stg_gc_f1_info) \
315 SymX(stg_gc_d1_info) \
317 SymX(stg_gc_l1_info) \
320 SymX(stg_gc_fun_info) \
321 SymX(stg_gc_fun_ret) \
323 SymX(stg_gc_gen_info) \
324 SymX(stg_gc_gen_hp) \
326 SymX(stg_gen_yield) \
327 SymX(stg_yield_noregs) \
328 SymX(stg_yield_to_interpreter) \
329 SymX(stg_gen_block) \
330 SymX(stg_block_noregs) \
332 SymX(stg_block_takemvar) \
333 SymX(stg_block_putmvar) \
334 SymX(stg_seq_frame_info) \
337 SymX(MallocFailHook) \
339 SymX(OutOfHeapHook) \
340 SymX(PatErrorHdrHook) \
341 SymX(PostTraceHook) \
343 SymX(StackOverflowHook) \
344 SymX(__encodeDouble) \
345 SymX(__encodeFloat) \
348 SymX(__gmpz_cmp_si) \
349 SymX(__gmpz_cmp_ui) \
350 SymX(__gmpz_get_si) \
351 SymX(__gmpz_get_ui) \
352 SymX(__int_encodeDouble) \
353 SymX(__int_encodeFloat) \
354 SymX(andIntegerzh_fast) \
355 SymX(blockAsyncExceptionszh_fast) \
358 SymX(complementIntegerzh_fast) \
359 SymX(cmpIntegerzh_fast) \
360 SymX(cmpIntegerIntzh_fast) \
361 SymX(createAdjustor) \
362 SymX(decodeDoublezh_fast) \
363 SymX(decodeFloatzh_fast) \
366 SymX(deRefWeakzh_fast) \
367 SymX(deRefStablePtrzh_fast) \
368 SymX(divExactIntegerzh_fast) \
369 SymX(divModIntegerzh_fast) \
371 SymX(forkProcesszh_fast) \
372 SymX(freeHaskellFunctionPtr) \
373 SymX(freeStablePtr) \
374 SymX(gcdIntegerzh_fast) \
375 SymX(gcdIntegerIntzh_fast) \
376 SymX(gcdIntzh_fast) \
379 SymX(int2Integerzh_fast) \
380 SymX(integer2Intzh_fast) \
381 SymX(integer2Wordzh_fast) \
382 SymX(isDoubleDenormalized) \
383 SymX(isDoubleInfinite) \
385 SymX(isDoubleNegativeZero) \
386 SymX(isEmptyMVarzh_fast) \
387 SymX(isFloatDenormalized) \
388 SymX(isFloatInfinite) \
390 SymX(isFloatNegativeZero) \
391 SymX(killThreadzh_fast) \
392 SymX(makeStablePtrzh_fast) \
393 SymX(minusIntegerzh_fast) \
394 SymX(mkApUpd0zh_fast) \
395 SymX(myThreadIdzh_fast) \
396 SymX(labelThreadzh_fast) \
397 SymX(newArrayzh_fast) \
398 SymX(newBCOzh_fast) \
399 SymX(newByteArrayzh_fast) \
400 SymX_redirect(newCAF, newDynCAF) \
401 SymX(newMVarzh_fast) \
402 SymX(newMutVarzh_fast) \
403 SymX(atomicModifyMutVarzh_fast) \
404 SymX(newPinnedByteArrayzh_fast) \
405 SymX(orIntegerzh_fast) \
407 SymX(plusIntegerzh_fast) \
410 SymX(putMVarzh_fast) \
411 SymX(quotIntegerzh_fast) \
412 SymX(quotRemIntegerzh_fast) \
414 SymX(remIntegerzh_fast) \
415 SymX(resetNonBlockingFd) \
418 SymX(rts_checkSchedStatus) \
421 SymX(rts_evalLazyIO) \
425 SymX(rts_getDouble) \
430 SymX(rts_getFunPtr) \
431 SymX(rts_getStablePtr) \
432 SymX(rts_getThreadId) \
434 SymX(rts_getWord32) \
447 SymX(rts_mkStablePtr) \
457 SymX(startupHaskell) \
458 SymX(shutdownHaskell) \
459 SymX(shutdownHaskellAndExit) \
460 SymX(stable_ptr_table) \
461 SymX(stackOverflow) \
462 SymX(stg_CAF_BLACKHOLE_info) \
463 SymX(stg_CHARLIKE_closure) \
464 SymX(stg_EMPTY_MVAR_info) \
465 SymX(stg_IND_STATIC_info) \
466 SymX(stg_INTLIKE_closure) \
467 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
468 SymX(stg_WEAK_info) \
469 SymX(stg_ap_v_info) \
470 SymX(stg_ap_f_info) \
471 SymX(stg_ap_d_info) \
472 SymX(stg_ap_l_info) \
473 SymX(stg_ap_n_info) \
474 SymX(stg_ap_p_info) \
475 SymX(stg_ap_pv_info) \
476 SymX(stg_ap_pp_info) \
477 SymX(stg_ap_ppv_info) \
478 SymX(stg_ap_ppp_info) \
479 SymX(stg_ap_pppp_info) \
480 SymX(stg_ap_ppppp_info) \
481 SymX(stg_ap_pppppp_info) \
482 SymX(stg_ap_ppppppp_info) \
490 SymX(stg_ap_pv_ret) \
491 SymX(stg_ap_pp_ret) \
492 SymX(stg_ap_ppv_ret) \
493 SymX(stg_ap_ppp_ret) \
494 SymX(stg_ap_pppp_ret) \
495 SymX(stg_ap_ppppp_ret) \
496 SymX(stg_ap_pppppp_ret) \
497 SymX(stg_ap_ppppppp_ret) \
498 SymX(stg_ap_1_upd_info) \
499 SymX(stg_ap_2_upd_info) \
500 SymX(stg_ap_3_upd_info) \
501 SymX(stg_ap_4_upd_info) \
502 SymX(stg_ap_5_upd_info) \
503 SymX(stg_ap_6_upd_info) \
504 SymX(stg_ap_7_upd_info) \
505 SymX(stg_ap_8_upd_info) \
507 SymX(stg_sel_0_upd_info) \
508 SymX(stg_sel_10_upd_info) \
509 SymX(stg_sel_11_upd_info) \
510 SymX(stg_sel_12_upd_info) \
511 SymX(stg_sel_13_upd_info) \
512 SymX(stg_sel_14_upd_info) \
513 SymX(stg_sel_15_upd_info) \
514 SymX(stg_sel_1_upd_info) \
515 SymX(stg_sel_2_upd_info) \
516 SymX(stg_sel_3_upd_info) \
517 SymX(stg_sel_4_upd_info) \
518 SymX(stg_sel_5_upd_info) \
519 SymX(stg_sel_6_upd_info) \
520 SymX(stg_sel_7_upd_info) \
521 SymX(stg_sel_8_upd_info) \
522 SymX(stg_sel_9_upd_info) \
523 SymX(stg_upd_frame_info) \
524 SymX(suspendThread) \
525 SymX(takeMVarzh_fast) \
526 SymX(timesIntegerzh_fast) \
527 SymX(tryPutMVarzh_fast) \
528 SymX(tryTakeMVarzh_fast) \
529 SymX(unblockAsyncExceptionszh_fast) \
530 SymX(unsafeThawArrayzh_fast) \
531 SymX(waitReadzh_fast) \
532 SymX(waitWritezh_fast) \
533 SymX(word2Integerzh_fast) \
534 SymX(xorIntegerzh_fast) \
537 #ifdef SUPPORT_LONG_LONGS
538 #define RTS_LONG_LONG_SYMS \
539 SymX(int64ToIntegerzh_fast) \
540 SymX(word64ToIntegerzh_fast)
542 #define RTS_LONG_LONG_SYMS /* nothing */
545 // 64-bit support functions in libgcc.a
546 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
547 #define RTS_LIBGCC_SYMBOLS \
557 #define RTS_LIBGCC_SYMBOLS
560 #ifdef ia64_TARGET_ARCH
561 /* force these symbols to be present */
562 #define RTS_EXTRA_SYMBOLS \
565 #define RTS_EXTRA_SYMBOLS /* nothing */
568 #ifdef darwin_TARGET_OS
569 // Symbols that don't have a leading underscore
570 // on Mac OS X. They have to receive special treatment,
571 // see machoInitSymbolsWithoutUnderscore()
572 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
577 /* entirely bogus claims about types of these symbols */
578 #define Sym(vvv) extern void (vvv);
579 #define SymX(vvv) /**/
580 #define SymX_redirect(vvv,xxx) /**/
584 RTS_POSIX_ONLY_SYMBOLS
585 RTS_MINGW_ONLY_SYMBOLS
586 RTS_CYGWIN_ONLY_SYMBOLS
592 #ifdef LEADING_UNDERSCORE
593 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
595 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
598 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
600 #define SymX(vvv) Sym(vvv)
602 // SymX_redirect allows us to redirect references to one symbol to
603 // another symbol. See newCAF/newDynCAF for an example.
604 #define SymX_redirect(vvv,xxx) \
605 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
608 static RtsSymbolVal rtsSyms[] = {
612 RTS_POSIX_ONLY_SYMBOLS
613 RTS_MINGW_ONLY_SYMBOLS
614 RTS_CYGWIN_ONLY_SYMBOLS
616 { 0, 0 } /* sentinel */
619 /* -----------------------------------------------------------------------------
620 * Insert symbols into hash tables, checking for duplicates.
622 static void ghciInsertStrHashTable ( char* obj_name,
628 if (lookupHashTable(table, (StgWord)key) == NULL)
630 insertStrHashTable(table, (StgWord)key, data);
635 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
637 "whilst processing object file\n"
639 "This could be caused by:\n"
640 " * Loading two different object files which export the same symbol\n"
641 " * Specifying the same object file twice on the GHCi command line\n"
642 " * An incorrect `package.conf' entry, causing some object to be\n"
644 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
653 /* -----------------------------------------------------------------------------
654 * initialize the object linker
658 static int linker_init_done = 0 ;
660 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
661 static void *dl_prog_handle;
669 /* Make initLinker idempotent, so we can call it
670 before evey relevant operation; that means we
671 don't need to initialise the linker separately */
672 if (linker_init_done == 1) { return; } else {
673 linker_init_done = 1;
676 symhash = allocStrHashTable();
678 /* populate the symbol table with stuff from the RTS */
679 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
680 ghciInsertStrHashTable("(GHCi built-in symbols)",
681 symhash, sym->lbl, sym->addr);
683 # if defined(OBJFORMAT_MACHO)
684 machoInitSymbolsWithoutUnderscore();
687 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
688 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
692 /* -----------------------------------------------------------------------------
693 * Loading DLL or .so dynamic libraries
694 * -----------------------------------------------------------------------------
696 * Add a DLL from which symbols may be found. In the ELF case, just
697 * do RTLD_GLOBAL-style add, so no further messing around needs to
698 * happen in order that symbols in the loaded .so are findable --
699 * lookupSymbol() will subsequently see them by dlsym on the program's
700 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
702 * In the PEi386 case, open the DLLs and put handles to them in a
703 * linked list. When looking for a symbol, try all handles in the
704 * list. This means that we need to load even DLLs that are guaranteed
705 * to be in the ghc.exe image already, just so we can get a handle
706 * to give to loadSymbol, so that we can find the symbols. For such
707 * libraries, the LoadLibrary call should be a no-op except for returning
712 #if defined(OBJFORMAT_PEi386)
713 /* A record for storing handles into DLLs. */
718 struct _OpenedDLL* next;
723 /* A list thereof. */
724 static OpenedDLL* opened_dlls = NULL;
728 addDLL( char *dll_name )
730 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
731 /* ------------------- ELF DLL loader ------------------- */
737 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
739 /* dlopen failed; return a ptr to the error msg. */
741 if (errmsg == NULL) errmsg = "addDLL: unknown error";
748 # elif defined(OBJFORMAT_PEi386)
749 /* ------------------- Win32 DLL loader ------------------- */
757 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
759 /* See if we've already got it, and ignore if so. */
760 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
761 if (0 == strcmp(o_dll->name, dll_name))
765 /* The file name has no suffix (yet) so that we can try
766 both foo.dll and foo.drv
768 The documentation for LoadLibrary says:
769 If no file name extension is specified in the lpFileName
770 parameter, the default library extension .dll is
771 appended. However, the file name string can include a trailing
772 point character (.) to indicate that the module name has no
775 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
776 sprintf(buf, "%s.DLL", dll_name);
777 instance = LoadLibrary(buf);
778 if (instance == NULL) {
779 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
780 instance = LoadLibrary(buf);
781 if (instance == NULL) {
784 /* LoadLibrary failed; return a ptr to the error msg. */
785 return "addDLL: unknown error";
790 /* Add this DLL to the list of DLLs in which to search for symbols. */
791 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
792 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
793 strcpy(o_dll->name, dll_name);
794 o_dll->instance = instance;
795 o_dll->next = opened_dlls;
800 barf("addDLL: not implemented on this platform");
804 /* -----------------------------------------------------------------------------
805 * lookup a symbol in the hash table
808 lookupSymbol( char *lbl )
812 ASSERT(symhash != NULL);
813 val = lookupStrHashTable(symhash, lbl);
816 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
817 return dlsym(dl_prog_handle, lbl);
818 # elif defined(OBJFORMAT_PEi386)
821 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
822 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
824 /* HACK: if the name has an initial underscore, try stripping
825 it off & look that up first. I've yet to verify whether there's
826 a Rule that governs whether an initial '_' *should always* be
827 stripped off when mapping from import lib name to the DLL name.
829 sym = GetProcAddress(o_dll->instance, (lbl+1));
831 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
835 sym = GetProcAddress(o_dll->instance, lbl);
837 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
852 __attribute((unused))
854 lookupLocalSymbol( ObjectCode* oc, char *lbl )
858 val = lookupStrHashTable(oc->lochash, lbl);
868 /* -----------------------------------------------------------------------------
869 * Debugging aid: look in GHCi's object symbol tables for symbols
870 * within DELTA bytes of the specified address, and show their names.
873 void ghci_enquire ( char* addr );
875 void ghci_enquire ( char* addr )
880 const int DELTA = 64;
885 for (oc = objects; oc; oc = oc->next) {
886 for (i = 0; i < oc->n_symbols; i++) {
887 sym = oc->symbols[i];
888 if (sym == NULL) continue;
889 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
891 if (oc->lochash != NULL) {
892 a = lookupStrHashTable(oc->lochash, sym);
895 a = lookupStrHashTable(symhash, sym);
898 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
900 else if (addr-DELTA <= a && a <= addr+DELTA) {
901 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
908 #ifdef ia64_TARGET_ARCH
909 static unsigned int PLTSize(void);
912 /* -----------------------------------------------------------------------------
913 * Load an obj (populate the global symbol table, but don't resolve yet)
915 * Returns: 1 if ok, 0 on error.
918 loadObj( char *path )
932 /* fprintf(stderr, "loadObj %s\n", path ); */
934 /* Check that we haven't already loaded this object. Don't give up
935 at this stage; ocGetNames_* will barf later. */
939 for (o = objects; o; o = o->next) {
940 if (0 == strcmp(o->fileName, path))
946 "GHCi runtime linker: warning: looks like you're trying to load the\n"
947 "same object file twice:\n"
949 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
955 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
957 # if defined(OBJFORMAT_ELF)
958 oc->formatName = "ELF";
959 # elif defined(OBJFORMAT_PEi386)
960 oc->formatName = "PEi386";
961 # elif defined(OBJFORMAT_MACHO)
962 oc->formatName = "Mach-O";
965 barf("loadObj: not implemented on this platform");
969 if (r == -1) { return 0; }
971 /* sigh, strdup() isn't a POSIX function, so do it the long way */
972 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
973 strcpy(oc->fileName, path);
975 oc->fileSize = st.st_size;
978 oc->lochash = allocStrHashTable();
979 oc->proddables = NULL;
981 /* chain it onto the list of objects */
986 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
988 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
990 fd = open(path, O_RDONLY);
992 barf("loadObj: can't open `%s'", path);
994 pagesize = getpagesize();
996 #ifdef ia64_TARGET_ARCH
997 /* The PLT needs to be right before the object */
998 n = ROUND_UP(PLTSize(), pagesize);
999 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1000 if (oc->plt == MAP_FAILED)
1001 barf("loadObj: can't allocate PLT");
1004 map_addr = oc->plt + n;
1007 n = ROUND_UP(oc->fileSize, pagesize);
1008 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1009 if (oc->image == MAP_FAILED)
1010 barf("loadObj: can't map `%s'", path);
1014 #else /* !USE_MMAP */
1016 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1018 /* load the image into memory */
1019 f = fopen(path, "rb");
1021 barf("loadObj: can't read `%s'", path);
1023 n = fread ( oc->image, 1, oc->fileSize, f );
1024 if (n != oc->fileSize)
1025 barf("loadObj: error whilst reading `%s'", path);
1029 #endif /* USE_MMAP */
1031 /* verify the in-memory image */
1032 # if defined(OBJFORMAT_ELF)
1033 r = ocVerifyImage_ELF ( oc );
1034 # elif defined(OBJFORMAT_PEi386)
1035 r = ocVerifyImage_PEi386 ( oc );
1036 # elif defined(OBJFORMAT_MACHO)
1037 r = ocVerifyImage_MachO ( oc );
1039 barf("loadObj: no verify method");
1041 if (!r) { return r; }
1043 /* build the symbol list for this image */
1044 # if defined(OBJFORMAT_ELF)
1045 r = ocGetNames_ELF ( oc );
1046 # elif defined(OBJFORMAT_PEi386)
1047 r = ocGetNames_PEi386 ( oc );
1048 # elif defined(OBJFORMAT_MACHO)
1049 r = ocGetNames_MachO ( oc );
1051 barf("loadObj: no getNames method");
1053 if (!r) { return r; }
1055 /* loaded, but not resolved yet */
1056 oc->status = OBJECT_LOADED;
1061 /* -----------------------------------------------------------------------------
1062 * resolve all the currently unlinked objects in memory
1064 * Returns: 1 if ok, 0 on error.
1074 for (oc = objects; oc; oc = oc->next) {
1075 if (oc->status != OBJECT_RESOLVED) {
1076 # if defined(OBJFORMAT_ELF)
1077 r = ocResolve_ELF ( oc );
1078 # elif defined(OBJFORMAT_PEi386)
1079 r = ocResolve_PEi386 ( oc );
1080 # elif defined(OBJFORMAT_MACHO)
1081 r = ocResolve_MachO ( oc );
1083 barf("resolveObjs: not implemented on this platform");
1085 if (!r) { return r; }
1086 oc->status = OBJECT_RESOLVED;
1092 /* -----------------------------------------------------------------------------
1093 * delete an object from the pool
1096 unloadObj( char *path )
1098 ObjectCode *oc, *prev;
1100 ASSERT(symhash != NULL);
1101 ASSERT(objects != NULL);
1106 for (oc = objects; oc; prev = oc, oc = oc->next) {
1107 if (!strcmp(oc->fileName,path)) {
1109 /* Remove all the mappings for the symbols within this
1114 for (i = 0; i < oc->n_symbols; i++) {
1115 if (oc->symbols[i] != NULL) {
1116 removeStrHashTable(symhash, oc->symbols[i], NULL);
1124 prev->next = oc->next;
1127 /* We're going to leave this in place, in case there are
1128 any pointers from the heap into it: */
1129 /* stgFree(oc->image); */
1130 stgFree(oc->fileName);
1131 stgFree(oc->symbols);
1132 stgFree(oc->sections);
1133 /* The local hash table should have been freed at the end
1134 of the ocResolve_ call on it. */
1135 ASSERT(oc->lochash == NULL);
1141 belch("unloadObj: can't find `%s' to unload", path);
1145 /* -----------------------------------------------------------------------------
1146 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1147 * which may be prodded during relocation, and abort if we try and write
1148 * outside any of these.
1150 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1153 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1154 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1158 pb->next = oc->proddables;
1159 oc->proddables = pb;
1162 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1165 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1166 char* s = (char*)(pb->start);
1167 char* e = s + pb->size - 1;
1168 char* a = (char*)addr;
1169 /* Assumes that the biggest fixup involves a 4-byte write. This
1170 probably needs to be changed to 8 (ie, +7) on 64-bit
1172 if (a >= s && (a+3) <= e) return;
1174 barf("checkProddableBlock: invalid fixup in runtime linker");
1177 /* -----------------------------------------------------------------------------
1178 * Section management.
1180 static void addSection ( ObjectCode* oc, SectionKind kind,
1181 void* start, void* end )
1183 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1187 s->next = oc->sections;
1190 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1191 start, ((char*)end)-1, end - start + 1, kind );
1197 /* --------------------------------------------------------------------------
1198 * PEi386 specifics (Win32 targets)
1199 * ------------------------------------------------------------------------*/
1201 /* The information for this linker comes from
1202 Microsoft Portable Executable
1203 and Common Object File Format Specification
1204 revision 5.1 January 1998
1205 which SimonM says comes from the MS Developer Network CDs.
1207 It can be found there (on older CDs), but can also be found
1210 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1212 (this is Rev 6.0 from February 1999).
1214 Things move, so if that fails, try searching for it via
1216 http://www.google.com/search?q=PE+COFF+specification
1218 The ultimate reference for the PE format is the Winnt.h
1219 header file that comes with the Platform SDKs; as always,
1220 implementations will drift wrt their documentation.
1222 A good background article on the PE format is Matt Pietrek's
1223 March 1994 article in Microsoft System Journal (MSJ)
1224 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1225 Win32 Portable Executable File Format." The info in there
1226 has recently been updated in a two part article in
1227 MSDN magazine, issues Feb and March 2002,
1228 "Inside Windows: An In-Depth Look into the Win32 Portable
1229 Executable File Format"
1231 John Levine's book "Linkers and Loaders" contains useful
1236 #if defined(OBJFORMAT_PEi386)
1240 typedef unsigned char UChar;
1241 typedef unsigned short UInt16;
1242 typedef unsigned int UInt32;
1249 UInt16 NumberOfSections;
1250 UInt32 TimeDateStamp;
1251 UInt32 PointerToSymbolTable;
1252 UInt32 NumberOfSymbols;
1253 UInt16 SizeOfOptionalHeader;
1254 UInt16 Characteristics;
1258 #define sizeof_COFF_header 20
1265 UInt32 VirtualAddress;
1266 UInt32 SizeOfRawData;
1267 UInt32 PointerToRawData;
1268 UInt32 PointerToRelocations;
1269 UInt32 PointerToLinenumbers;
1270 UInt16 NumberOfRelocations;
1271 UInt16 NumberOfLineNumbers;
1272 UInt32 Characteristics;
1276 #define sizeof_COFF_section 40
1283 UInt16 SectionNumber;
1286 UChar NumberOfAuxSymbols;
1290 #define sizeof_COFF_symbol 18
1295 UInt32 VirtualAddress;
1296 UInt32 SymbolTableIndex;
1301 #define sizeof_COFF_reloc 10
1304 /* From PE spec doc, section 3.3.2 */
1305 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1306 windows.h -- for the same purpose, but I want to know what I'm
1308 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1309 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1310 #define MYIMAGE_FILE_DLL 0x2000
1311 #define MYIMAGE_FILE_SYSTEM 0x1000
1312 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1313 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1314 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1316 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1317 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1318 #define MYIMAGE_SYM_CLASS_STATIC 3
1319 #define MYIMAGE_SYM_UNDEFINED 0
1321 /* From PE spec doc, section 4.1 */
1322 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1323 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1324 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1326 /* From PE spec doc, section 5.2.1 */
1327 #define MYIMAGE_REL_I386_DIR32 0x0006
1328 #define MYIMAGE_REL_I386_REL32 0x0014
1331 /* We use myindex to calculate array addresses, rather than
1332 simply doing the normal subscript thing. That's because
1333 some of the above structs have sizes which are not
1334 a whole number of words. GCC rounds their sizes up to a
1335 whole number of words, which means that the address calcs
1336 arising from using normal C indexing or pointer arithmetic
1337 are just plain wrong. Sigh.
1340 myindex ( int scale, void* base, int index )
1343 ((UChar*)base) + scale * index;
1348 printName ( UChar* name, UChar* strtab )
1350 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1351 UInt32 strtab_offset = * (UInt32*)(name+4);
1352 fprintf ( stderr, "%s", strtab + strtab_offset );
1355 for (i = 0; i < 8; i++) {
1356 if (name[i] == 0) break;
1357 fprintf ( stderr, "%c", name[i] );
1364 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1366 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1367 UInt32 strtab_offset = * (UInt32*)(name+4);
1368 strncpy ( dst, strtab+strtab_offset, dstSize );
1374 if (name[i] == 0) break;
1384 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1387 /* If the string is longer than 8 bytes, look in the
1388 string table for it -- this will be correctly zero terminated.
1390 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1391 UInt32 strtab_offset = * (UInt32*)(name+4);
1392 return ((UChar*)strtab) + strtab_offset;
1394 /* Otherwise, if shorter than 8 bytes, return the original,
1395 which by defn is correctly terminated.
1397 if (name[7]==0) return name;
1398 /* The annoying case: 8 bytes. Copy into a temporary
1399 (which is never freed ...)
1401 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1403 strncpy(newstr,name,8);
1409 /* Just compares the short names (first 8 chars) */
1410 static COFF_section *
1411 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1415 = (COFF_header*)(oc->image);
1416 COFF_section* sectab
1418 ((UChar*)(oc->image))
1419 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1421 for (i = 0; i < hdr->NumberOfSections; i++) {
1424 COFF_section* section_i
1426 myindex ( sizeof_COFF_section, sectab, i );
1427 n1 = (UChar*) &(section_i->Name);
1429 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1430 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1431 n1[6]==n2[6] && n1[7]==n2[7])
1440 zapTrailingAtSign ( UChar* sym )
1442 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1444 if (sym[0] == 0) return;
1446 while (sym[i] != 0) i++;
1449 while (j > 0 && my_isdigit(sym[j])) j--;
1450 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1456 ocVerifyImage_PEi386 ( ObjectCode* oc )
1461 COFF_section* sectab;
1462 COFF_symbol* symtab;
1464 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1465 hdr = (COFF_header*)(oc->image);
1466 sectab = (COFF_section*) (
1467 ((UChar*)(oc->image))
1468 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1470 symtab = (COFF_symbol*) (
1471 ((UChar*)(oc->image))
1472 + hdr->PointerToSymbolTable
1474 strtab = ((UChar*)symtab)
1475 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1477 if (hdr->Machine != 0x14c) {
1478 belch("Not x86 PEi386");
1481 if (hdr->SizeOfOptionalHeader != 0) {
1482 belch("PEi386 with nonempty optional header");
1485 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1486 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1487 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1488 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1489 belch("Not a PEi386 object file");
1492 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1493 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1494 belch("Invalid PEi386 word size or endiannness: %d",
1495 (int)(hdr->Characteristics));
1498 /* If the string table size is way crazy, this might indicate that
1499 there are more than 64k relocations, despite claims to the
1500 contrary. Hence this test. */
1501 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1503 if ( (*(UInt32*)strtab) > 600000 ) {
1504 /* Note that 600k has no special significance other than being
1505 big enough to handle the almost-2MB-sized lumps that
1506 constitute HSwin32*.o. */
1507 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1512 /* No further verification after this point; only debug printing. */
1514 IF_DEBUG(linker, i=1);
1515 if (i == 0) return 1;
1518 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1520 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1522 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1524 fprintf ( stderr, "\n" );
1526 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1528 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1530 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1532 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1534 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1536 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1538 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1540 /* Print the section table. */
1541 fprintf ( stderr, "\n" );
1542 for (i = 0; i < hdr->NumberOfSections; i++) {
1544 COFF_section* sectab_i
1546 myindex ( sizeof_COFF_section, sectab, i );
1553 printName ( sectab_i->Name, strtab );
1563 sectab_i->VirtualSize,
1564 sectab_i->VirtualAddress,
1565 sectab_i->SizeOfRawData,
1566 sectab_i->PointerToRawData,
1567 sectab_i->NumberOfRelocations,
1568 sectab_i->PointerToRelocations,
1569 sectab_i->PointerToRawData
1571 reltab = (COFF_reloc*) (
1572 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1575 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1576 /* If the relocation field (a short) has overflowed, the
1577 * real count can be found in the first reloc entry.
1579 * See Section 4.1 (last para) of the PE spec (rev6.0).
1581 COFF_reloc* rel = (COFF_reloc*)
1582 myindex ( sizeof_COFF_reloc, reltab, 0 );
1583 noRelocs = rel->VirtualAddress;
1586 noRelocs = sectab_i->NumberOfRelocations;
1590 for (; j < noRelocs; j++) {
1592 COFF_reloc* rel = (COFF_reloc*)
1593 myindex ( sizeof_COFF_reloc, reltab, j );
1595 " type 0x%-4x vaddr 0x%-8x name `",
1597 rel->VirtualAddress );
1598 sym = (COFF_symbol*)
1599 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1600 /* Hmm..mysterious looking offset - what's it for? SOF */
1601 printName ( sym->Name, strtab -10 );
1602 fprintf ( stderr, "'\n" );
1605 fprintf ( stderr, "\n" );
1607 fprintf ( stderr, "\n" );
1608 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1609 fprintf ( stderr, "---START of string table---\n");
1610 for (i = 4; i < *(Int32*)strtab; i++) {
1612 fprintf ( stderr, "\n"); else
1613 fprintf( stderr, "%c", strtab[i] );
1615 fprintf ( stderr, "--- END of string table---\n");
1617 fprintf ( stderr, "\n" );
1620 COFF_symbol* symtab_i;
1621 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1622 symtab_i = (COFF_symbol*)
1623 myindex ( sizeof_COFF_symbol, symtab, i );
1629 printName ( symtab_i->Name, strtab );
1638 (Int32)(symtab_i->SectionNumber),
1639 (UInt32)symtab_i->Type,
1640 (UInt32)symtab_i->StorageClass,
1641 (UInt32)symtab_i->NumberOfAuxSymbols
1643 i += symtab_i->NumberOfAuxSymbols;
1647 fprintf ( stderr, "\n" );
1653 ocGetNames_PEi386 ( ObjectCode* oc )
1656 COFF_section* sectab;
1657 COFF_symbol* symtab;
1664 hdr = (COFF_header*)(oc->image);
1665 sectab = (COFF_section*) (
1666 ((UChar*)(oc->image))
1667 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1669 symtab = (COFF_symbol*) (
1670 ((UChar*)(oc->image))
1671 + hdr->PointerToSymbolTable
1673 strtab = ((UChar*)(oc->image))
1674 + hdr->PointerToSymbolTable
1675 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1677 /* Allocate space for any (local, anonymous) .bss sections. */
1679 for (i = 0; i < hdr->NumberOfSections; i++) {
1681 COFF_section* sectab_i
1683 myindex ( sizeof_COFF_section, sectab, i );
1684 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1685 if (sectab_i->VirtualSize == 0) continue;
1686 /* This is a non-empty .bss section. Allocate zeroed space for
1687 it, and set its PointerToRawData field such that oc->image +
1688 PointerToRawData == addr_of_zeroed_space. */
1689 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1690 "ocGetNames_PEi386(anonymous bss)");
1691 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1692 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1693 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1696 /* Copy section information into the ObjectCode. */
1698 for (i = 0; i < hdr->NumberOfSections; i++) {
1704 = SECTIONKIND_OTHER;
1705 COFF_section* sectab_i
1707 myindex ( sizeof_COFF_section, sectab, i );
1708 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1711 /* I'm sure this is the Right Way to do it. However, the
1712 alternative of testing the sectab_i->Name field seems to
1713 work ok with Cygwin.
1715 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1716 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1717 kind = SECTIONKIND_CODE_OR_RODATA;
1720 if (0==strcmp(".text",sectab_i->Name) ||
1721 0==strcmp(".rodata",sectab_i->Name))
1722 kind = SECTIONKIND_CODE_OR_RODATA;
1723 if (0==strcmp(".data",sectab_i->Name) ||
1724 0==strcmp(".bss",sectab_i->Name))
1725 kind = SECTIONKIND_RWDATA;
1727 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1728 sz = sectab_i->SizeOfRawData;
1729 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1731 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1732 end = start + sz - 1;
1734 if (kind == SECTIONKIND_OTHER
1735 /* Ignore sections called which contain stabs debugging
1737 && 0 != strcmp(".stab", sectab_i->Name)
1738 && 0 != strcmp(".stabstr", sectab_i->Name)
1740 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1744 if (kind != SECTIONKIND_OTHER && end >= start) {
1745 addSection(oc, kind, start, end);
1746 addProddableBlock(oc, start, end - start + 1);
1750 /* Copy exported symbols into the ObjectCode. */
1752 oc->n_symbols = hdr->NumberOfSymbols;
1753 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1754 "ocGetNames_PEi386(oc->symbols)");
1755 /* Call me paranoid; I don't care. */
1756 for (i = 0; i < oc->n_symbols; i++)
1757 oc->symbols[i] = NULL;
1761 COFF_symbol* symtab_i;
1762 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1763 symtab_i = (COFF_symbol*)
1764 myindex ( sizeof_COFF_symbol, symtab, i );
1768 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1769 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1770 /* This symbol is global and defined, viz, exported */
1771 /* for MYIMAGE_SYMCLASS_EXTERNAL
1772 && !MYIMAGE_SYM_UNDEFINED,
1773 the address of the symbol is:
1774 address of relevant section + offset in section
1776 COFF_section* sectabent
1777 = (COFF_section*) myindex ( sizeof_COFF_section,
1779 symtab_i->SectionNumber-1 );
1780 addr = ((UChar*)(oc->image))
1781 + (sectabent->PointerToRawData
1785 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1786 && symtab_i->Value > 0) {
1787 /* This symbol isn't in any section at all, ie, global bss.
1788 Allocate zeroed space for it. */
1789 addr = stgCallocBytes(1, symtab_i->Value,
1790 "ocGetNames_PEi386(non-anonymous bss)");
1791 addSection(oc, SECTIONKIND_RWDATA, addr,
1792 ((UChar*)addr) + symtab_i->Value - 1);
1793 addProddableBlock(oc, addr, symtab_i->Value);
1794 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1797 if (addr != NULL ) {
1798 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1799 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1800 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1801 ASSERT(i >= 0 && i < oc->n_symbols);
1802 /* cstring_from_COFF_symbol_name always succeeds. */
1803 oc->symbols[i] = sname;
1804 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1808 "IGNORING symbol %d\n"
1812 printName ( symtab_i->Name, strtab );
1821 (Int32)(symtab_i->SectionNumber),
1822 (UInt32)symtab_i->Type,
1823 (UInt32)symtab_i->StorageClass,
1824 (UInt32)symtab_i->NumberOfAuxSymbols
1829 i += symtab_i->NumberOfAuxSymbols;
1838 ocResolve_PEi386 ( ObjectCode* oc )
1841 COFF_section* sectab;
1842 COFF_symbol* symtab;
1852 /* ToDo: should be variable-sized? But is at least safe in the
1853 sense of buffer-overrun-proof. */
1855 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1857 hdr = (COFF_header*)(oc->image);
1858 sectab = (COFF_section*) (
1859 ((UChar*)(oc->image))
1860 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1862 symtab = (COFF_symbol*) (
1863 ((UChar*)(oc->image))
1864 + hdr->PointerToSymbolTable
1866 strtab = ((UChar*)(oc->image))
1867 + hdr->PointerToSymbolTable
1868 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1870 for (i = 0; i < hdr->NumberOfSections; i++) {
1871 COFF_section* sectab_i
1873 myindex ( sizeof_COFF_section, sectab, i );
1876 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1879 /* Ignore sections called which contain stabs debugging
1881 if (0 == strcmp(".stab", sectab_i->Name)
1882 || 0 == strcmp(".stabstr", sectab_i->Name))
1885 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1886 /* If the relocation field (a short) has overflowed, the
1887 * real count can be found in the first reloc entry.
1889 * See Section 4.1 (last para) of the PE spec (rev6.0).
1891 COFF_reloc* rel = (COFF_reloc*)
1892 myindex ( sizeof_COFF_reloc, reltab, 0 );
1893 noRelocs = rel->VirtualAddress;
1894 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1897 noRelocs = sectab_i->NumberOfRelocations;
1902 for (; j < noRelocs; j++) {
1904 COFF_reloc* reltab_j
1906 myindex ( sizeof_COFF_reloc, reltab, j );
1908 /* the location to patch */
1910 ((UChar*)(oc->image))
1911 + (sectab_i->PointerToRawData
1912 + reltab_j->VirtualAddress
1913 - sectab_i->VirtualAddress )
1915 /* the existing contents of pP */
1917 /* the symbol to connect to */
1918 sym = (COFF_symbol*)
1919 myindex ( sizeof_COFF_symbol,
1920 symtab, reltab_j->SymbolTableIndex );
1923 "reloc sec %2d num %3d: type 0x%-4x "
1924 "vaddr 0x%-8x name `",
1926 (UInt32)reltab_j->Type,
1927 reltab_j->VirtualAddress );
1928 printName ( sym->Name, strtab );
1929 fprintf ( stderr, "'\n" ));
1931 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1932 COFF_section* section_sym
1933 = findPEi386SectionCalled ( oc, sym->Name );
1935 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1938 S = ((UInt32)(oc->image))
1939 + (section_sym->PointerToRawData
1942 copyName ( sym->Name, strtab, symbol, 1000-1 );
1943 (void*)S = lookupLocalSymbol( oc, symbol );
1944 if ((void*)S != NULL) goto foundit;
1945 (void*)S = lookupSymbol( symbol );
1946 if ((void*)S != NULL) goto foundit;
1947 zapTrailingAtSign ( symbol );
1948 (void*)S = lookupLocalSymbol( oc, symbol );
1949 if ((void*)S != NULL) goto foundit;
1950 (void*)S = lookupSymbol( symbol );
1951 if ((void*)S != NULL) goto foundit;
1952 /* Newline first because the interactive linker has printed "linking..." */
1953 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1957 checkProddableBlock(oc, pP);
1958 switch (reltab_j->Type) {
1959 case MYIMAGE_REL_I386_DIR32:
1962 case MYIMAGE_REL_I386_REL32:
1963 /* Tricky. We have to insert a displacement at
1964 pP which, when added to the PC for the _next_
1965 insn, gives the address of the target (S).
1966 Problem is to know the address of the next insn
1967 when we only know pP. We assume that this
1968 literal field is always the last in the insn,
1969 so that the address of the next insn is pP+4
1970 -- hence the constant 4.
1971 Also I don't know if A should be added, but so
1972 far it has always been zero.
1975 *pP = S - ((UInt32)pP) - 4;
1978 belch("%s: unhandled PEi386 relocation type %d",
1979 oc->fileName, reltab_j->Type);
1986 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1990 #endif /* defined(OBJFORMAT_PEi386) */
1993 /* --------------------------------------------------------------------------
1995 * ------------------------------------------------------------------------*/
1997 #if defined(OBJFORMAT_ELF)
2002 #if defined(sparc_TARGET_ARCH)
2003 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2004 #elif defined(i386_TARGET_ARCH)
2005 # define ELF_TARGET_386 /* Used inside <elf.h> */
2006 #elif defined (ia64_TARGET_ARCH)
2007 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2009 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2010 # define ELF_NEED_GOT /* needs Global Offset Table */
2011 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2017 * Define a set of types which can be used for both ELF32 and ELF64
2021 #define ELFCLASS ELFCLASS64
2022 #define Elf_Addr Elf64_Addr
2023 #define Elf_Word Elf64_Word
2024 #define Elf_Sword Elf64_Sword
2025 #define Elf_Ehdr Elf64_Ehdr
2026 #define Elf_Phdr Elf64_Phdr
2027 #define Elf_Shdr Elf64_Shdr
2028 #define Elf_Sym Elf64_Sym
2029 #define Elf_Rel Elf64_Rel
2030 #define Elf_Rela Elf64_Rela
2031 #define ELF_ST_TYPE ELF64_ST_TYPE
2032 #define ELF_ST_BIND ELF64_ST_BIND
2033 #define ELF_R_TYPE ELF64_R_TYPE
2034 #define ELF_R_SYM ELF64_R_SYM
2036 #define ELFCLASS ELFCLASS32
2037 #define Elf_Addr Elf32_Addr
2038 #define Elf_Word Elf32_Word
2039 #define Elf_Sword Elf32_Sword
2040 #define Elf_Ehdr Elf32_Ehdr
2041 #define Elf_Phdr Elf32_Phdr
2042 #define Elf_Shdr Elf32_Shdr
2043 #define Elf_Sym Elf32_Sym
2044 #define Elf_Rel Elf32_Rel
2045 #define Elf_Rela Elf32_Rela
2046 #define ELF_ST_TYPE ELF32_ST_TYPE
2047 #define ELF_ST_BIND ELF32_ST_BIND
2048 #define ELF_R_TYPE ELF32_R_TYPE
2049 #define ELF_R_SYM ELF32_R_SYM
2054 * Functions to allocate entries in dynamic sections. Currently we simply
2055 * preallocate a large number, and we don't check if a entry for the given
2056 * target already exists (a linear search is too slow). Ideally these
2057 * entries would be associated with symbols.
2060 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2061 #define GOT_SIZE 0x20000
2062 #define FUNCTION_TABLE_SIZE 0x10000
2063 #define PLT_SIZE 0x08000
2066 static Elf_Addr got[GOT_SIZE];
2067 static unsigned int gotIndex;
2068 static Elf_Addr gp_val = (Elf_Addr)got;
2071 allocateGOTEntry(Elf_Addr target)
2075 if (gotIndex >= GOT_SIZE)
2076 barf("Global offset table overflow");
2078 entry = &got[gotIndex++];
2080 return (Elf_Addr)entry;
2084 #ifdef ELF_FUNCTION_DESC
2090 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2091 static unsigned int functionTableIndex;
2094 allocateFunctionDesc(Elf_Addr target)
2096 FunctionDesc *entry;
2098 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2099 barf("Function table overflow");
2101 entry = &functionTable[functionTableIndex++];
2103 entry->gp = (Elf_Addr)gp_val;
2104 return (Elf_Addr)entry;
2108 copyFunctionDesc(Elf_Addr target)
2110 FunctionDesc *olddesc = (FunctionDesc *)target;
2111 FunctionDesc *newdesc;
2113 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2114 newdesc->gp = olddesc->gp;
2115 return (Elf_Addr)newdesc;
2120 #ifdef ia64_TARGET_ARCH
2121 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2122 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2124 static unsigned char plt_code[] =
2126 /* taken from binutils bfd/elfxx-ia64.c */
2127 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2128 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2129 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2130 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2131 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2132 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2135 /* If we can't get to the function descriptor via gp, take a local copy of it */
2136 #define PLT_RELOC(code, target) { \
2137 Elf64_Sxword rel_value = target - gp_val; \
2138 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2139 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2141 ia64_reloc_gprel22((Elf_Addr)code, target); \
2146 unsigned char code[sizeof(plt_code)];
2150 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2152 PLTEntry *plt = (PLTEntry *)oc->plt;
2155 if (oc->pltIndex >= PLT_SIZE)
2156 barf("Procedure table overflow");
2158 entry = &plt[oc->pltIndex++];
2159 memcpy(entry->code, plt_code, sizeof(entry->code));
2160 PLT_RELOC(entry->code, target);
2161 return (Elf_Addr)entry;
2167 return (PLT_SIZE * sizeof(PLTEntry));
2173 * Generic ELF functions
2177 findElfSection ( void* objImage, Elf_Word sh_type )
2179 char* ehdrC = (char*)objImage;
2180 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2181 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2182 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2186 for (i = 0; i < ehdr->e_shnum; i++) {
2187 if (shdr[i].sh_type == sh_type
2188 /* Ignore the section header's string table. */
2189 && i != ehdr->e_shstrndx
2190 /* Ignore string tables named .stabstr, as they contain
2192 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2194 ptr = ehdrC + shdr[i].sh_offset;
2201 #if defined(ia64_TARGET_ARCH)
2203 findElfSegment ( void* objImage, Elf_Addr vaddr )
2205 char* ehdrC = (char*)objImage;
2206 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2207 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2208 Elf_Addr segaddr = 0;
2211 for (i = 0; i < ehdr->e_phnum; i++) {
2212 segaddr = phdr[i].p_vaddr;
2213 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2221 ocVerifyImage_ELF ( ObjectCode* oc )
2225 int i, j, nent, nstrtab, nsymtabs;
2229 char* ehdrC = (char*)(oc->image);
2230 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2232 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2233 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2234 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2235 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2236 belch("%s: not an ELF object", oc->fileName);
2240 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2241 belch("%s: unsupported ELF format", oc->fileName);
2245 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2246 IF_DEBUG(linker,belch( "Is little-endian" ));
2248 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2249 IF_DEBUG(linker,belch( "Is big-endian" ));
2251 belch("%s: unknown endiannness", oc->fileName);
2255 if (ehdr->e_type != ET_REL) {
2256 belch("%s: not a relocatable object (.o) file", oc->fileName);
2259 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2261 IF_DEBUG(linker,belch( "Architecture is " ));
2262 switch (ehdr->e_machine) {
2263 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2264 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2266 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2268 default: IF_DEBUG(linker,belch( "unknown" ));
2269 belch("%s: unknown architecture", oc->fileName);
2273 IF_DEBUG(linker,belch(
2274 "\nSection header table: start %d, n_entries %d, ent_size %d",
2275 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2277 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2279 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2281 if (ehdr->e_shstrndx == SHN_UNDEF) {
2282 belch("%s: no section header string table", oc->fileName);
2285 IF_DEBUG(linker,belch( "Section header string table is section %d",
2287 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2290 for (i = 0; i < ehdr->e_shnum; i++) {
2291 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2292 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2293 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2294 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2295 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2296 ehdrC + shdr[i].sh_offset,
2297 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2299 if (shdr[i].sh_type == SHT_REL) {
2300 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2301 } else if (shdr[i].sh_type == SHT_RELA) {
2302 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2304 IF_DEBUG(linker,fprintf(stderr," "));
2307 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2311 IF_DEBUG(linker,belch( "\nString tables" ));
2314 for (i = 0; i < ehdr->e_shnum; i++) {
2315 if (shdr[i].sh_type == SHT_STRTAB
2316 /* Ignore the section header's string table. */
2317 && i != ehdr->e_shstrndx
2318 /* Ignore string tables named .stabstr, as they contain
2320 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2322 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2323 strtab = ehdrC + shdr[i].sh_offset;
2328 belch("%s: no string tables, or too many", oc->fileName);
2333 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2334 for (i = 0; i < ehdr->e_shnum; i++) {
2335 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2336 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2338 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2339 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2340 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2342 shdr[i].sh_size % sizeof(Elf_Sym)
2344 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2345 belch("%s: non-integral number of symbol table entries", oc->fileName);
2348 for (j = 0; j < nent; j++) {
2349 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2350 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2351 (int)stab[j].st_shndx,
2352 (int)stab[j].st_size,
2353 (char*)stab[j].st_value ));
2355 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2356 switch (ELF_ST_TYPE(stab[j].st_info)) {
2357 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2358 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2359 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2360 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2361 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2362 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2364 IF_DEBUG(linker,fprintf(stderr, " " ));
2366 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2367 switch (ELF_ST_BIND(stab[j].st_info)) {
2368 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2369 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2370 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2371 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2373 IF_DEBUG(linker,fprintf(stderr, " " ));
2375 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2379 if (nsymtabs == 0) {
2380 belch("%s: didn't find any symbol tables", oc->fileName);
2389 ocGetNames_ELF ( ObjectCode* oc )
2394 char* ehdrC = (char*)(oc->image);
2395 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2396 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2397 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2399 ASSERT(symhash != NULL);
2402 belch("%s: no strtab", oc->fileName);
2407 for (i = 0; i < ehdr->e_shnum; i++) {
2408 /* Figure out what kind of section it is. Logic derived from
2409 Figure 1.14 ("Special Sections") of the ELF document
2410 ("Portable Formats Specification, Version 1.1"). */
2411 Elf_Shdr hdr = shdr[i];
2412 SectionKind kind = SECTIONKIND_OTHER;
2415 if (hdr.sh_type == SHT_PROGBITS
2416 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2417 /* .text-style section */
2418 kind = SECTIONKIND_CODE_OR_RODATA;
2421 if (hdr.sh_type == SHT_PROGBITS
2422 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2423 /* .data-style section */
2424 kind = SECTIONKIND_RWDATA;
2427 if (hdr.sh_type == SHT_PROGBITS
2428 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2429 /* .rodata-style section */
2430 kind = SECTIONKIND_CODE_OR_RODATA;
2433 if (hdr.sh_type == SHT_NOBITS
2434 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2435 /* .bss-style section */
2436 kind = SECTIONKIND_RWDATA;
2440 if (is_bss && shdr[i].sh_size > 0) {
2441 /* This is a non-empty .bss section. Allocate zeroed space for
2442 it, and set its .sh_offset field such that
2443 ehdrC + .sh_offset == addr_of_zeroed_space. */
2444 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2445 "ocGetNames_ELF(BSS)");
2446 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2448 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2449 zspace, shdr[i].sh_size);
2453 /* fill in the section info */
2454 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2455 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2456 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2457 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2460 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2462 /* copy stuff into this module's object symbol table */
2463 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2464 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2466 oc->n_symbols = nent;
2467 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2468 "ocGetNames_ELF(oc->symbols)");
2470 for (j = 0; j < nent; j++) {
2472 char isLocal = FALSE; /* avoids uninit-var warning */
2474 char* nm = strtab + stab[j].st_name;
2475 int secno = stab[j].st_shndx;
2477 /* Figure out if we want to add it; if so, set ad to its
2478 address. Otherwise leave ad == NULL. */
2480 if (secno == SHN_COMMON) {
2482 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2484 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2485 stab[j].st_size, nm);
2487 /* Pointless to do addProddableBlock() for this area,
2488 since the linker should never poke around in it. */
2491 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2492 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2494 /* and not an undefined symbol */
2495 && stab[j].st_shndx != SHN_UNDEF
2496 /* and not in a "special section" */
2497 && stab[j].st_shndx < SHN_LORESERVE
2499 /* and it's a not a section or string table or anything silly */
2500 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2501 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2502 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2505 /* Section 0 is the undefined section, hence > and not >=. */
2506 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2508 if (shdr[secno].sh_type == SHT_NOBITS) {
2509 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2510 stab[j].st_size, stab[j].st_value, nm);
2513 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2514 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2517 #ifdef ELF_FUNCTION_DESC
2518 /* dlsym() and the initialisation table both give us function
2519 * descriptors, so to be consistent we store function descriptors
2520 * in the symbol table */
2521 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2522 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2524 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2525 ad, oc->fileName, nm ));
2530 /* And the decision is ... */
2534 oc->symbols[j] = nm;
2537 /* Ignore entirely. */
2539 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2543 IF_DEBUG(linker,belch( "skipping `%s'",
2544 strtab + stab[j].st_name ));
2547 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2548 (int)ELF_ST_BIND(stab[j].st_info),
2549 (int)ELF_ST_TYPE(stab[j].st_info),
2550 (int)stab[j].st_shndx,
2551 strtab + stab[j].st_name
2554 oc->symbols[j] = NULL;
2563 /* Do ELF relocations which lack an explicit addend. All x86-linux
2564 relocations appear to be of this form. */
2566 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2567 Elf_Shdr* shdr, int shnum,
2568 Elf_Sym* stab, char* strtab )
2573 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2574 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2575 int target_shndx = shdr[shnum].sh_info;
2576 int symtab_shndx = shdr[shnum].sh_link;
2578 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2579 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2580 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2581 target_shndx, symtab_shndx ));
2583 for (j = 0; j < nent; j++) {
2584 Elf_Addr offset = rtab[j].r_offset;
2585 Elf_Addr info = rtab[j].r_info;
2587 Elf_Addr P = ((Elf_Addr)targ) + offset;
2588 Elf_Word* pP = (Elf_Word*)P;
2593 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2594 j, (void*)offset, (void*)info ));
2596 IF_DEBUG(linker,belch( " ZERO" ));
2599 Elf_Sym sym = stab[ELF_R_SYM(info)];
2600 /* First see if it is a local symbol. */
2601 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2602 /* Yes, so we can get the address directly from the ELF symbol
2604 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2606 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2607 + stab[ELF_R_SYM(info)].st_value);
2610 /* No, so look up the name in our global table. */
2611 symbol = strtab + sym.st_name;
2612 (void*)S = lookupSymbol( symbol );
2615 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2618 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2621 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2622 (void*)P, (void*)S, (void*)A ));
2623 checkProddableBlock ( oc, pP );
2627 switch (ELF_R_TYPE(info)) {
2628 # ifdef i386_TARGET_ARCH
2629 case R_386_32: *pP = value; break;
2630 case R_386_PC32: *pP = value - P; break;
2633 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2634 oc->fileName, ELF_R_TYPE(info));
2642 /* Do ELF relocations for which explicit addends are supplied.
2643 sparc-solaris relocations appear to be of this form. */
2645 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2646 Elf_Shdr* shdr, int shnum,
2647 Elf_Sym* stab, char* strtab )
2652 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2653 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2654 int target_shndx = shdr[shnum].sh_info;
2655 int symtab_shndx = shdr[shnum].sh_link;
2657 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2658 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2659 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2660 target_shndx, symtab_shndx ));
2662 for (j = 0; j < nent; j++) {
2663 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2664 /* This #ifdef only serves to avoid unused-var warnings. */
2665 Elf_Addr offset = rtab[j].r_offset;
2666 Elf_Addr P = targ + offset;
2668 Elf_Addr info = rtab[j].r_info;
2669 Elf_Addr A = rtab[j].r_addend;
2672 # if defined(sparc_TARGET_ARCH)
2673 Elf_Word* pP = (Elf_Word*)P;
2675 # elif defined(ia64_TARGET_ARCH)
2676 Elf64_Xword *pP = (Elf64_Xword *)P;
2680 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2681 j, (void*)offset, (void*)info,
2684 IF_DEBUG(linker,belch( " ZERO" ));
2687 Elf_Sym sym = stab[ELF_R_SYM(info)];
2688 /* First see if it is a local symbol. */
2689 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2690 /* Yes, so we can get the address directly from the ELF symbol
2692 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2694 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2695 + stab[ELF_R_SYM(info)].st_value);
2696 #ifdef ELF_FUNCTION_DESC
2697 /* Make a function descriptor for this function */
2698 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2699 S = allocateFunctionDesc(S + A);
2704 /* No, so look up the name in our global table. */
2705 symbol = strtab + sym.st_name;
2706 (void*)S = lookupSymbol( symbol );
2708 #ifdef ELF_FUNCTION_DESC
2709 /* If a function, already a function descriptor - we would
2710 have to copy it to add an offset. */
2711 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2716 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2719 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2722 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2723 (void*)P, (void*)S, (void*)A ));
2724 /* checkProddableBlock ( oc, (void*)P ); */
2728 switch (ELF_R_TYPE(info)) {
2729 # if defined(sparc_TARGET_ARCH)
2730 case R_SPARC_WDISP30:
2731 w1 = *pP & 0xC0000000;
2732 w2 = (Elf_Word)((value - P) >> 2);
2733 ASSERT((w2 & 0xC0000000) == 0);
2738 w1 = *pP & 0xFFC00000;
2739 w2 = (Elf_Word)(value >> 10);
2740 ASSERT((w2 & 0xFFC00000) == 0);
2746 w2 = (Elf_Word)(value & 0x3FF);
2747 ASSERT((w2 & ~0x3FF) == 0);
2751 /* According to the Sun documentation:
2753 This relocation type resembles R_SPARC_32, except it refers to an
2754 unaligned word. That is, the word to be relocated must be treated
2755 as four separate bytes with arbitrary alignment, not as a word
2756 aligned according to the architecture requirements.
2758 (JRS: which means that freeloading on the R_SPARC_32 case
2759 is probably wrong, but hey ...)
2763 w2 = (Elf_Word)value;
2766 # elif defined(ia64_TARGET_ARCH)
2767 case R_IA64_DIR64LSB:
2768 case R_IA64_FPTR64LSB:
2771 case R_IA64_SEGREL64LSB:
2772 addr = findElfSegment(ehdrC, value);
2775 case R_IA64_GPREL22:
2776 ia64_reloc_gprel22(P, value);
2778 case R_IA64_LTOFF22:
2779 case R_IA64_LTOFF_FPTR22:
2780 addr = allocateGOTEntry(value);
2781 ia64_reloc_gprel22(P, addr);
2783 case R_IA64_PCREL21B:
2784 ia64_reloc_pcrel21(P, S, oc);
2788 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2789 oc->fileName, ELF_R_TYPE(info));
2798 ocResolve_ELF ( ObjectCode* oc )
2802 Elf_Sym* stab = NULL;
2803 char* ehdrC = (char*)(oc->image);
2804 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2805 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2806 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2808 /* first find "the" symbol table */
2809 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2811 /* also go find the string table */
2812 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2814 if (stab == NULL || strtab == NULL) {
2815 belch("%s: can't find string or symbol table", oc->fileName);
2819 /* Process the relocation sections. */
2820 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2822 /* Skip sections called ".rel.stab". These appear to contain
2823 relocation entries that, when done, make the stabs debugging
2824 info point at the right places. We ain't interested in all
2826 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2829 if (shdr[shnum].sh_type == SHT_REL ) {
2830 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2831 shnum, stab, strtab );
2835 if (shdr[shnum].sh_type == SHT_RELA) {
2836 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2837 shnum, stab, strtab );
2842 /* Free the local symbol table; we won't need it again. */
2843 freeHashTable(oc->lochash, NULL);
2851 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2852 * at the front. The following utility functions pack and unpack instructions, and
2853 * take care of the most common relocations.
2856 #ifdef ia64_TARGET_ARCH
2859 ia64_extract_instruction(Elf64_Xword *target)
2862 int slot = (Elf_Addr)target & 3;
2863 (Elf_Addr)target &= ~3;
2871 return ((w1 >> 5) & 0x1ffffffffff);
2873 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2877 barf("ia64_extract_instruction: invalid slot %p", target);
2882 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2884 int slot = (Elf_Addr)target & 3;
2885 (Elf_Addr)target &= ~3;
2890 *target |= value << 5;
2893 *target |= value << 46;
2894 *(target+1) |= value >> 18;
2897 *(target+1) |= value << 23;
2903 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2905 Elf64_Xword instruction;
2906 Elf64_Sxword rel_value;
2908 rel_value = value - gp_val;
2909 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2910 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2912 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2913 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2914 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2915 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2916 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2917 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2921 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2923 Elf64_Xword instruction;
2924 Elf64_Sxword rel_value;
2927 entry = allocatePLTEntry(value, oc);
2929 rel_value = (entry >> 4) - (target >> 4);
2930 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2931 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2933 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2934 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2935 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2936 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2943 /* --------------------------------------------------------------------------
2945 * ------------------------------------------------------------------------*/
2947 #if defined(OBJFORMAT_MACHO)
2950 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2951 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2953 I hereby formally apologize for the hackish nature of this code.
2954 Things that need to be done:
2955 *) get common symbols and .bss sections to work properly.
2956 Haskell modules seem to work, but C modules can cause problems
2957 *) implement ocVerifyImage_MachO
2958 *) add more sanity checks. The current code just has to segfault if there's a
2962 static int ocVerifyImage_MachO(ObjectCode* oc)
2964 // FIXME: do some verifying here
2968 static int resolveImports(
2971 struct symtab_command *symLC,
2972 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2973 unsigned long *indirectSyms,
2974 struct nlist *nlist)
2978 for(i=0;i*4<sect->size;i++)
2980 // according to otool, reserved1 contains the first index into the indirect symbol table
2981 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2982 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
2985 if((symbol->n_type & N_TYPE) == N_UNDF
2986 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
2987 addr = (void*) (symbol->n_value);
2988 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
2991 addr = lookupSymbol(nm);
2994 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
2998 ((void**)(image + sect->offset))[i] = addr;
3004 static int relocateSection(char *image,
3005 struct symtab_command *symLC, struct nlist *nlist,
3006 struct section* sections, struct section *sect)
3008 struct relocation_info *relocs;
3011 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3013 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3017 relocs = (struct relocation_info*) (image + sect->reloff);
3021 if(relocs[i].r_address & R_SCATTERED)
3023 struct scattered_relocation_info *scat =
3024 (struct scattered_relocation_info*) &relocs[i];
3028 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3030 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3032 *word = scat->r_value + sect->offset + ((long) image);
3036 continue; // FIXME: I hope it's OK to ignore all the others.
3040 struct relocation_info *reloc = &relocs[i];
3041 if(reloc->r_pcrel && !reloc->r_extern)
3044 if(reloc->r_length == 2)
3046 unsigned long word = 0;
3048 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3050 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3054 else if(reloc->r_type == PPC_RELOC_LO16)
3056 word = ((unsigned short*) wordPtr)[1];
3057 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3059 else if(reloc->r_type == PPC_RELOC_HI16)
3061 word = ((unsigned short*) wordPtr)[1] << 16;
3062 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3064 else if(reloc->r_type == PPC_RELOC_HA16)
3066 word = ((unsigned short*) wordPtr)[1] << 16;
3067 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3069 else if(reloc->r_type == PPC_RELOC_BR24)
3072 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3076 if(!reloc->r_extern)
3079 sections[reloc->r_symbolnum-1].offset
3080 - sections[reloc->r_symbolnum-1].addr
3087 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3088 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3089 word = (unsigned long) (lookupSymbol(nm));
3092 belch("\nunknown symbol `%s'", nm);
3097 word -= ((long)image) + sect->offset + reloc->r_address;
3100 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3105 else if(reloc->r_type == PPC_RELOC_LO16)
3107 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3110 else if(reloc->r_type == PPC_RELOC_HI16)
3112 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3115 else if(reloc->r_type == PPC_RELOC_HA16)
3117 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3118 + ((word & (1<<15)) ? 1 : 0);
3121 else if(reloc->r_type == PPC_RELOC_BR24)
3123 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3127 barf("\nunknown relocation %d",reloc->r_type);
3134 static int ocGetNames_MachO(ObjectCode* oc)
3136 char *image = (char*) oc->image;
3137 struct mach_header *header = (struct mach_header*) image;
3138 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3139 unsigned i,curSymbol;
3140 struct segment_command *segLC = NULL;
3141 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3142 struct symtab_command *symLC = NULL;
3143 struct dysymtab_command *dsymLC = NULL;
3144 struct nlist *nlist;
3145 unsigned long commonSize = 0;
3146 char *commonStorage = NULL;
3147 unsigned long commonCounter;
3149 for(i=0;i<header->ncmds;i++)
3151 if(lc->cmd == LC_SEGMENT)
3152 segLC = (struct segment_command*) lc;
3153 else if(lc->cmd == LC_SYMTAB)
3154 symLC = (struct symtab_command*) lc;
3155 else if(lc->cmd == LC_DYSYMTAB)
3156 dsymLC = (struct dysymtab_command*) lc;
3157 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3160 sections = (struct section*) (segLC+1);
3161 nlist = (struct nlist*) (image + symLC->symoff);
3163 for(i=0;i<segLC->nsects;i++)
3165 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3166 la_ptrs = §ions[i];
3167 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3168 nl_ptrs = §ions[i];
3170 // for now, only add __text and __const to the sections table
3171 else if(!strcmp(sections[i].sectname,"__text"))
3172 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3173 (void*) (image + sections[i].offset),
3174 (void*) (image + sections[i].offset + sections[i].size));
3175 else if(!strcmp(sections[i].sectname,"__const"))
3176 addSection(oc, SECTIONKIND_RWDATA,
3177 (void*) (image + sections[i].offset),
3178 (void*) (image + sections[i].offset + sections[i].size));
3179 else if(!strcmp(sections[i].sectname,"__data"))
3180 addSection(oc, SECTIONKIND_RWDATA,
3181 (void*) (image + sections[i].offset),
3182 (void*) (image + sections[i].offset + sections[i].size));
3185 // count external symbols defined here
3187 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3189 if((nlist[i].n_type & N_TYPE) == N_SECT)
3192 for(i=0;i<symLC->nsyms;i++)
3194 if((nlist[i].n_type & N_TYPE) == N_UNDF
3195 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3197 commonSize += nlist[i].n_value;
3201 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3202 "ocGetNames_MachO(oc->symbols)");
3204 // insert symbols into hash table
3205 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3207 if((nlist[i].n_type & N_TYPE) == N_SECT)
3209 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3210 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3211 sections[nlist[i].n_sect-1].offset
3212 - sections[nlist[i].n_sect-1].addr
3213 + nlist[i].n_value);
3214 oc->symbols[curSymbol++] = nm;
3218 // insert local symbols into lochash
3219 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3221 if((nlist[i].n_type & N_TYPE) == N_SECT)
3223 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3224 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3225 sections[nlist[i].n_sect-1].offset
3226 - sections[nlist[i].n_sect-1].addr
3227 + nlist[i].n_value);
3232 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3233 commonCounter = (unsigned long)commonStorage;
3234 for(i=0;i<symLC->nsyms;i++)
3236 if((nlist[i].n_type & N_TYPE) == N_UNDF
3237 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3239 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3240 unsigned long sz = nlist[i].n_value;
3242 nlist[i].n_value = commonCounter;
3244 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3245 oc->symbols[curSymbol++] = nm;
3247 commonCounter += sz;
3253 static int ocResolve_MachO(ObjectCode* oc)
3255 char *image = (char*) oc->image;
3256 struct mach_header *header = (struct mach_header*) image;
3257 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3259 struct segment_command *segLC = NULL;
3260 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3261 struct symtab_command *symLC = NULL;
3262 struct dysymtab_command *dsymLC = NULL;
3263 struct nlist *nlist;
3264 unsigned long *indirectSyms;
3266 for(i=0;i<header->ncmds;i++)
3268 if(lc->cmd == LC_SEGMENT)
3269 segLC = (struct segment_command*) lc;
3270 else if(lc->cmd == LC_SYMTAB)
3271 symLC = (struct symtab_command*) lc;
3272 else if(lc->cmd == LC_DYSYMTAB)
3273 dsymLC = (struct dysymtab_command*) lc;
3274 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3277 sections = (struct section*) (segLC+1);
3278 nlist = (struct nlist*) (image + symLC->symoff);
3280 for(i=0;i<segLC->nsects;i++)
3282 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3283 la_ptrs = §ions[i];
3284 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3285 nl_ptrs = §ions[i];
3288 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3291 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3294 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3297 for(i=0;i<segLC->nsects;i++)
3299 if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
3303 /* Free the local symbol table; we won't need it again. */
3304 freeHashTable(oc->lochash, NULL);
3310 * The Mach-O object format uses leading underscores. But not everywhere.
3311 * There is a small number of runtime support functions defined in
3312 * libcc_dynamic.a whose name does not have a leading underscore.
3313 * As a consequence, we can't get their address from C code.
3314 * We have to use inline assembler just to take the address of a function.
3318 static void machoInitSymbolsWithoutUnderscore()
3324 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3325 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3327 RTS_MACHO_NOUNDERLINE_SYMBOLS