1 /* -----------------------------------------------------------------------------
2 * $Id: Linker.c,v 1.124 2003/06/26 20:58:33 panne Exp $
4 * (c) The GHC Team, 2000-2003
8 * ---------------------------------------------------------------------------*/
11 #include "PosixSource.h"
18 #include "LinkerInternals.h"
20 #include "StoragePriv.h"
23 #ifdef HAVE_SYS_TYPES_H
24 #include <sys/types.h>
30 #ifdef HAVE_SYS_STAT_H
34 #if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
35 #include <HaskellSupport/dlfcn.h>
36 #elif defined(HAVE_DLFCN_H)
40 #if defined(cygwin32_TARGET_OS)
45 #ifdef HAVE_SYS_TIME_H
49 #include <sys/fcntl.h>
50 #include <sys/termios.h>
51 #include <sys/utime.h>
52 #include <sys/utsname.h>
56 #if defined(ia64_TARGET_ARCH)
62 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS)
63 # define OBJFORMAT_ELF
64 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
65 # define OBJFORMAT_PEi386
68 #elif defined(darwin_TARGET_OS)
69 # include <mach-o/ppc/reloc.h>
70 # define OBJFORMAT_MACHO
71 # include <mach-o/loader.h>
72 # include <mach-o/nlist.h>
73 # include <mach-o/reloc.h>
76 /* Hash table mapping symbol names to Symbol */
77 static /*Str*/HashTable *symhash;
79 /* List of currently loaded objects */
80 ObjectCode *objects = NULL; /* initially empty */
82 #if defined(OBJFORMAT_ELF)
83 static int ocVerifyImage_ELF ( ObjectCode* oc );
84 static int ocGetNames_ELF ( ObjectCode* oc );
85 static int ocResolve_ELF ( ObjectCode* oc );
86 #elif defined(OBJFORMAT_PEi386)
87 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
88 static int ocGetNames_PEi386 ( ObjectCode* oc );
89 static int ocResolve_PEi386 ( ObjectCode* oc );
90 #elif defined(OBJFORMAT_MACHO)
91 static int ocVerifyImage_MachO ( ObjectCode* oc );
92 static int ocGetNames_MachO ( ObjectCode* oc );
93 static int ocResolve_MachO ( ObjectCode* oc );
95 static void machoInitSymbolsWithoutUnderscore( void );
98 /* -----------------------------------------------------------------------------
99 * Built-in symbols from the RTS
102 typedef struct _RtsSymbolVal {
109 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
111 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
112 SymX(makeStableNamezh_fast) \
113 SymX(finalizzeWeakzh_fast)
115 /* These are not available in GUM!!! -- HWL */
116 #define Maybe_ForeignObj
117 #define Maybe_Stable_Names
120 #if !defined (mingw32_TARGET_OS)
121 #define RTS_POSIX_ONLY_SYMBOLS \
122 SymX(stg_sig_install) \
126 #if defined (cygwin32_TARGET_OS)
127 #define RTS_MINGW_ONLY_SYMBOLS /**/
128 /* Don't have the ability to read import libs / archives, so
129 * we have to stupidly list a lot of what libcygwin.a
132 #define RTS_CYGWIN_ONLY_SYMBOLS \
210 #elif !defined(mingw32_TARGET_OS)
211 #define RTS_MINGW_ONLY_SYMBOLS /**/
212 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
213 #else /* defined(mingw32_TARGET_OS) */
214 #define RTS_POSIX_ONLY_SYMBOLS /**/
215 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
217 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
219 #define RTS_MINGW_EXTRA_SYMS \
220 Sym(_imp____mb_cur_max) \
223 #define RTS_MINGW_EXTRA_SYMS
226 /* These are statically linked from the mingw libraries into the ghc
227 executable, so we have to employ this hack. */
228 #define RTS_MINGW_ONLY_SYMBOLS \
229 SymX(asyncReadzh_fast) \
230 SymX(asyncWritezh_fast) \
242 SymX(getservbyname) \
243 SymX(getservbyport) \
244 SymX(getprotobynumber) \
245 SymX(getprotobyname) \
246 SymX(gethostbyname) \
247 SymX(gethostbyaddr) \
282 Sym(_imp___timezone) \
290 RTS_MINGW_EXTRA_SYMS \
295 # define MAIN_CAP_SYM SymX(MainCapability)
297 # define MAIN_CAP_SYM
300 #define RTS_SYMBOLS \
304 SymX(stg_enter_info) \
305 SymX(stg_enter_ret) \
306 SymX(stg_gc_void_info) \
307 SymX(__stg_gc_enter_1) \
308 SymX(stg_gc_noregs) \
309 SymX(stg_gc_unpt_r1_info) \
310 SymX(stg_gc_unpt_r1) \
311 SymX(stg_gc_unbx_r1_info) \
312 SymX(stg_gc_unbx_r1) \
313 SymX(stg_gc_f1_info) \
315 SymX(stg_gc_d1_info) \
317 SymX(stg_gc_l1_info) \
320 SymX(stg_gc_fun_info) \
321 SymX(stg_gc_fun_ret) \
323 SymX(stg_gc_gen_info) \
324 SymX(stg_gc_gen_hp) \
326 SymX(stg_gen_yield) \
327 SymX(stg_yield_noregs) \
328 SymX(stg_yield_to_interpreter) \
329 SymX(stg_gen_block) \
330 SymX(stg_block_noregs) \
332 SymX(stg_block_takemvar) \
333 SymX(stg_block_putmvar) \
334 SymX(stg_seq_frame_info) \
337 SymX(MallocFailHook) \
339 SymX(OutOfHeapHook) \
340 SymX(PatErrorHdrHook) \
341 SymX(PostTraceHook) \
343 SymX(StackOverflowHook) \
344 SymX(__encodeDouble) \
345 SymX(__encodeFloat) \
348 SymX(__gmpz_cmp_si) \
349 SymX(__gmpz_cmp_ui) \
350 SymX(__gmpz_get_si) \
351 SymX(__gmpz_get_ui) \
352 SymX(__int_encodeDouble) \
353 SymX(__int_encodeFloat) \
354 SymX(andIntegerzh_fast) \
355 SymX(blockAsyncExceptionszh_fast) \
358 SymX(complementIntegerzh_fast) \
359 SymX(cmpIntegerzh_fast) \
360 SymX(cmpIntegerIntzh_fast) \
361 SymX(createAdjustor) \
362 SymX(decodeDoublezh_fast) \
363 SymX(decodeFloatzh_fast) \
366 SymX(deRefWeakzh_fast) \
367 SymX(deRefStablePtrzh_fast) \
368 SymX(divExactIntegerzh_fast) \
369 SymX(divModIntegerzh_fast) \
371 SymX(forkProcesszh_fast) \
372 SymX(freeHaskellFunctionPtr) \
373 SymX(freeStablePtr) \
374 SymX(gcdIntegerzh_fast) \
375 SymX(gcdIntegerIntzh_fast) \
376 SymX(gcdIntzh_fast) \
379 SymX(int2Integerzh_fast) \
380 SymX(integer2Intzh_fast) \
381 SymX(integer2Wordzh_fast) \
382 SymX(isDoubleDenormalized) \
383 SymX(isDoubleInfinite) \
385 SymX(isDoubleNegativeZero) \
386 SymX(isEmptyMVarzh_fast) \
387 SymX(isFloatDenormalized) \
388 SymX(isFloatInfinite) \
390 SymX(isFloatNegativeZero) \
391 SymX(killThreadzh_fast) \
392 SymX(makeStablePtrzh_fast) \
393 SymX(minusIntegerzh_fast) \
394 SymX(mkApUpd0zh_fast) \
395 SymX(myThreadIdzh_fast) \
396 SymX(labelThreadzh_fast) \
397 SymX(newArrayzh_fast) \
398 SymX(newBCOzh_fast) \
399 SymX(newByteArrayzh_fast) \
400 SymX_redirect(newCAF, newDynCAF) \
401 SymX(newMVarzh_fast) \
402 SymX(newMutVarzh_fast) \
403 SymX(atomicModifyMutVarzh_fast) \
404 SymX(newPinnedByteArrayzh_fast) \
405 SymX(orIntegerzh_fast) \
407 SymX(plusIntegerzh_fast) \
410 SymX(putMVarzh_fast) \
411 SymX(quotIntegerzh_fast) \
412 SymX(quotRemIntegerzh_fast) \
414 SymX(raiseIOzh_fast) \
415 SymX(remIntegerzh_fast) \
416 SymX(resetNonBlockingFd) \
419 SymX(rts_checkSchedStatus) \
422 SymX(rts_evalLazyIO) \
426 SymX(rts_getDouble) \
431 SymX(rts_getFunPtr) \
432 SymX(rts_getStablePtr) \
433 SymX(rts_getThreadId) \
435 SymX(rts_getWord32) \
448 SymX(rts_mkStablePtr) \
458 SymX(startupHaskell) \
459 SymX(shutdownHaskell) \
460 SymX(shutdownHaskellAndExit) \
461 SymX(stable_ptr_table) \
462 SymX(stackOverflow) \
463 SymX(stg_CAF_BLACKHOLE_info) \
464 SymX(stg_CHARLIKE_closure) \
465 SymX(stg_EMPTY_MVAR_info) \
466 SymX(stg_IND_STATIC_info) \
467 SymX(stg_INTLIKE_closure) \
468 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
469 SymX(stg_WEAK_info) \
470 SymX(stg_ap_v_info) \
471 SymX(stg_ap_f_info) \
472 SymX(stg_ap_d_info) \
473 SymX(stg_ap_l_info) \
474 SymX(stg_ap_n_info) \
475 SymX(stg_ap_p_info) \
476 SymX(stg_ap_pv_info) \
477 SymX(stg_ap_pp_info) \
478 SymX(stg_ap_ppv_info) \
479 SymX(stg_ap_ppp_info) \
480 SymX(stg_ap_pppp_info) \
481 SymX(stg_ap_ppppp_info) \
482 SymX(stg_ap_pppppp_info) \
483 SymX(stg_ap_ppppppp_info) \
491 SymX(stg_ap_pv_ret) \
492 SymX(stg_ap_pp_ret) \
493 SymX(stg_ap_ppv_ret) \
494 SymX(stg_ap_ppp_ret) \
495 SymX(stg_ap_pppp_ret) \
496 SymX(stg_ap_ppppp_ret) \
497 SymX(stg_ap_pppppp_ret) \
498 SymX(stg_ap_ppppppp_ret) \
499 SymX(stg_ap_1_upd_info) \
500 SymX(stg_ap_2_upd_info) \
501 SymX(stg_ap_3_upd_info) \
502 SymX(stg_ap_4_upd_info) \
503 SymX(stg_ap_5_upd_info) \
504 SymX(stg_ap_6_upd_info) \
505 SymX(stg_ap_7_upd_info) \
506 SymX(stg_ap_8_upd_info) \
508 SymX(stg_sel_0_upd_info) \
509 SymX(stg_sel_10_upd_info) \
510 SymX(stg_sel_11_upd_info) \
511 SymX(stg_sel_12_upd_info) \
512 SymX(stg_sel_13_upd_info) \
513 SymX(stg_sel_14_upd_info) \
514 SymX(stg_sel_15_upd_info) \
515 SymX(stg_sel_1_upd_info) \
516 SymX(stg_sel_2_upd_info) \
517 SymX(stg_sel_3_upd_info) \
518 SymX(stg_sel_4_upd_info) \
519 SymX(stg_sel_5_upd_info) \
520 SymX(stg_sel_6_upd_info) \
521 SymX(stg_sel_7_upd_info) \
522 SymX(stg_sel_8_upd_info) \
523 SymX(stg_sel_9_upd_info) \
524 SymX(stg_upd_frame_info) \
525 SymX(suspendThread) \
526 SymX(takeMVarzh_fast) \
527 SymX(timesIntegerzh_fast) \
528 SymX(tryPutMVarzh_fast) \
529 SymX(tryTakeMVarzh_fast) \
530 SymX(unblockAsyncExceptionszh_fast) \
531 SymX(unsafeThawArrayzh_fast) \
532 SymX(waitReadzh_fast) \
533 SymX(waitWritezh_fast) \
534 SymX(word2Integerzh_fast) \
535 SymX(xorIntegerzh_fast) \
538 #ifdef SUPPORT_LONG_LONGS
539 #define RTS_LONG_LONG_SYMS \
540 SymX(int64ToIntegerzh_fast) \
541 SymX(word64ToIntegerzh_fast)
543 #define RTS_LONG_LONG_SYMS /* nothing */
546 // 64-bit support functions in libgcc.a
547 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
548 #define RTS_LIBGCC_SYMBOLS \
557 #elif defined(ia64_TARGET_ARCH)
558 #define RTS_LIBGCC_SYMBOLS \
566 #define RTS_LIBGCC_SYMBOLS
569 #ifdef darwin_TARGET_OS
570 // Symbols that don't have a leading underscore
571 // on Mac OS X. They have to receive special treatment,
572 // see machoInitSymbolsWithoutUnderscore()
573 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
578 /* entirely bogus claims about types of these symbols */
579 #define Sym(vvv) extern void vvv(void);
580 #define SymX(vvv) /**/
581 #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[] = {
611 RTS_POSIX_ONLY_SYMBOLS
612 RTS_MINGW_ONLY_SYMBOLS
613 RTS_CYGWIN_ONLY_SYMBOLS
615 { 0, 0 } /* sentinel */
618 /* -----------------------------------------------------------------------------
619 * Insert symbols into hash tables, checking for duplicates.
621 static void ghciInsertStrHashTable ( char* obj_name,
627 if (lookupHashTable(table, (StgWord)key) == NULL)
629 insertStrHashTable(table, (StgWord)key, data);
634 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
636 "whilst processing object file\n"
638 "This could be caused by:\n"
639 " * Loading two different object files which export the same symbol\n"
640 " * Specifying the same object file twice on the GHCi command line\n"
641 " * An incorrect `package.conf' entry, causing some object to be\n"
643 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
652 /* -----------------------------------------------------------------------------
653 * initialize the object linker
657 static int linker_init_done = 0 ;
659 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
660 static void *dl_prog_handle;
668 /* Make initLinker idempotent, so we can call it
669 before evey relevant operation; that means we
670 don't need to initialise the linker separately */
671 if (linker_init_done == 1) { return; } else {
672 linker_init_done = 1;
675 symhash = allocStrHashTable();
677 /* populate the symbol table with stuff from the RTS */
678 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
679 ghciInsertStrHashTable("(GHCi built-in symbols)",
680 symhash, sym->lbl, sym->addr);
682 # if defined(OBJFORMAT_MACHO)
683 machoInitSymbolsWithoutUnderscore();
686 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
687 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
691 /* -----------------------------------------------------------------------------
692 * Loading DLL or .so dynamic libraries
693 * -----------------------------------------------------------------------------
695 * Add a DLL from which symbols may be found. In the ELF case, just
696 * do RTLD_GLOBAL-style add, so no further messing around needs to
697 * happen in order that symbols in the loaded .so are findable --
698 * lookupSymbol() will subsequently see them by dlsym on the program's
699 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
701 * In the PEi386 case, open the DLLs and put handles to them in a
702 * linked list. When looking for a symbol, try all handles in the
703 * list. This means that we need to load even DLLs that are guaranteed
704 * to be in the ghc.exe image already, just so we can get a handle
705 * to give to loadSymbol, so that we can find the symbols. For such
706 * libraries, the LoadLibrary call should be a no-op except for returning
711 #if defined(OBJFORMAT_PEi386)
712 /* A record for storing handles into DLLs. */
717 struct _OpenedDLL* next;
722 /* A list thereof. */
723 static OpenedDLL* opened_dlls = NULL;
727 addDLL( char *dll_name )
729 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
730 /* ------------------- ELF DLL loader ------------------- */
736 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
738 /* dlopen failed; return a ptr to the error msg. */
740 if (errmsg == NULL) errmsg = "addDLL: unknown error";
747 # elif defined(OBJFORMAT_PEi386)
748 /* ------------------- Win32 DLL loader ------------------- */
756 /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
758 /* See if we've already got it, and ignore if so. */
759 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
760 if (0 == strcmp(o_dll->name, dll_name))
764 /* The file name has no suffix (yet) so that we can try
765 both foo.dll and foo.drv
767 The documentation for LoadLibrary says:
768 If no file name extension is specified in the lpFileName
769 parameter, the default library extension .dll is
770 appended. However, the file name string can include a trailing
771 point character (.) to indicate that the module name has no
774 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
775 sprintf(buf, "%s.DLL", dll_name);
776 instance = LoadLibrary(buf);
777 if (instance == NULL) {
778 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
779 instance = LoadLibrary(buf);
780 if (instance == NULL) {
783 /* LoadLibrary failed; return a ptr to the error msg. */
784 return "addDLL: unknown error";
789 /* Add this DLL to the list of DLLs in which to search for symbols. */
790 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
791 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
792 strcpy(o_dll->name, dll_name);
793 o_dll->instance = instance;
794 o_dll->next = opened_dlls;
799 barf("addDLL: not implemented on this platform");
803 /* -----------------------------------------------------------------------------
804 * lookup a symbol in the hash table
807 lookupSymbol( char *lbl )
811 ASSERT(symhash != NULL);
812 val = lookupStrHashTable(symhash, lbl);
815 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
816 return dlsym(dl_prog_handle, lbl);
817 # elif defined(OBJFORMAT_PEi386)
820 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
821 /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
823 /* HACK: if the name has an initial underscore, try stripping
824 it off & look that up first. I've yet to verify whether there's
825 a Rule that governs whether an initial '_' *should always* be
826 stripped off when mapping from import lib name to the DLL name.
828 sym = GetProcAddress(o_dll->instance, (lbl+1));
830 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
834 sym = GetProcAddress(o_dll->instance, lbl);
836 /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
851 __attribute((unused))
853 lookupLocalSymbol( ObjectCode* oc, char *lbl )
857 val = lookupStrHashTable(oc->lochash, lbl);
867 /* -----------------------------------------------------------------------------
868 * Debugging aid: look in GHCi's object symbol tables for symbols
869 * within DELTA bytes of the specified address, and show their names.
872 void ghci_enquire ( char* addr );
874 void ghci_enquire ( char* addr )
879 const int DELTA = 64;
884 for (oc = objects; oc; oc = oc->next) {
885 for (i = 0; i < oc->n_symbols; i++) {
886 sym = oc->symbols[i];
887 if (sym == NULL) continue;
888 // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
890 if (oc->lochash != NULL) {
891 a = lookupStrHashTable(oc->lochash, sym);
894 a = lookupStrHashTable(symhash, sym);
897 // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
899 else if (addr-DELTA <= a && a <= addr+DELTA) {
900 fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
907 #ifdef ia64_TARGET_ARCH
908 static unsigned int PLTSize(void);
911 /* -----------------------------------------------------------------------------
912 * Load an obj (populate the global symbol table, but don't resolve yet)
914 * Returns: 1 if ok, 0 on error.
917 loadObj( char *path )
931 /* fprintf(stderr, "loadObj %s\n", path ); */
933 /* Check that we haven't already loaded this object. Don't give up
934 at this stage; ocGetNames_* will barf later. */
938 for (o = objects; o; o = o->next) {
939 if (0 == strcmp(o->fileName, path))
945 "GHCi runtime linker: warning: looks like you're trying to load the\n"
946 "same object file twice:\n"
948 "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
954 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
956 # if defined(OBJFORMAT_ELF)
957 oc->formatName = "ELF";
958 # elif defined(OBJFORMAT_PEi386)
959 oc->formatName = "PEi386";
960 # elif defined(OBJFORMAT_MACHO)
961 oc->formatName = "Mach-O";
964 barf("loadObj: not implemented on this platform");
968 if (r == -1) { return 0; }
970 /* sigh, strdup() isn't a POSIX function, so do it the long way */
971 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
972 strcpy(oc->fileName, path);
974 oc->fileSize = st.st_size;
977 oc->lochash = allocStrHashTable();
978 oc->proddables = NULL;
980 /* chain it onto the list of objects */
985 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
987 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
989 fd = open(path, O_RDONLY);
991 barf("loadObj: can't open `%s'", path);
993 pagesize = getpagesize();
995 #ifdef ia64_TARGET_ARCH
996 /* The PLT needs to be right before the object */
997 n = ROUND_UP(PLTSize(), pagesize);
998 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
999 if (oc->plt == MAP_FAILED)
1000 barf("loadObj: can't allocate PLT");
1003 map_addr = oc->plt + n;
1006 n = ROUND_UP(oc->fileSize, pagesize);
1007 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
1008 if (oc->image == MAP_FAILED)
1009 barf("loadObj: can't map `%s'", path);
1013 #else /* !USE_MMAP */
1015 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1017 /* load the image into memory */
1018 f = fopen(path, "rb");
1020 barf("loadObj: can't read `%s'", path);
1022 n = fread ( oc->image, 1, oc->fileSize, f );
1023 if (n != oc->fileSize)
1024 barf("loadObj: error whilst reading `%s'", path);
1028 #endif /* USE_MMAP */
1030 /* verify the in-memory image */
1031 # if defined(OBJFORMAT_ELF)
1032 r = ocVerifyImage_ELF ( oc );
1033 # elif defined(OBJFORMAT_PEi386)
1034 r = ocVerifyImage_PEi386 ( oc );
1035 # elif defined(OBJFORMAT_MACHO)
1036 r = ocVerifyImage_MachO ( oc );
1038 barf("loadObj: no verify method");
1040 if (!r) { return r; }
1042 /* build the symbol list for this image */
1043 # if defined(OBJFORMAT_ELF)
1044 r = ocGetNames_ELF ( oc );
1045 # elif defined(OBJFORMAT_PEi386)
1046 r = ocGetNames_PEi386 ( oc );
1047 # elif defined(OBJFORMAT_MACHO)
1048 r = ocGetNames_MachO ( oc );
1050 barf("loadObj: no getNames method");
1052 if (!r) { return r; }
1054 /* loaded, but not resolved yet */
1055 oc->status = OBJECT_LOADED;
1060 /* -----------------------------------------------------------------------------
1061 * resolve all the currently unlinked objects in memory
1063 * Returns: 1 if ok, 0 on error.
1073 for (oc = objects; oc; oc = oc->next) {
1074 if (oc->status != OBJECT_RESOLVED) {
1075 # if defined(OBJFORMAT_ELF)
1076 r = ocResolve_ELF ( oc );
1077 # elif defined(OBJFORMAT_PEi386)
1078 r = ocResolve_PEi386 ( oc );
1079 # elif defined(OBJFORMAT_MACHO)
1080 r = ocResolve_MachO ( oc );
1082 barf("resolveObjs: not implemented on this platform");
1084 if (!r) { return r; }
1085 oc->status = OBJECT_RESOLVED;
1091 /* -----------------------------------------------------------------------------
1092 * delete an object from the pool
1095 unloadObj( char *path )
1097 ObjectCode *oc, *prev;
1099 ASSERT(symhash != NULL);
1100 ASSERT(objects != NULL);
1105 for (oc = objects; oc; prev = oc, oc = oc->next) {
1106 if (!strcmp(oc->fileName,path)) {
1108 /* Remove all the mappings for the symbols within this
1113 for (i = 0; i < oc->n_symbols; i++) {
1114 if (oc->symbols[i] != NULL) {
1115 removeStrHashTable(symhash, oc->symbols[i], NULL);
1123 prev->next = oc->next;
1126 /* We're going to leave this in place, in case there are
1127 any pointers from the heap into it: */
1128 /* stgFree(oc->image); */
1129 stgFree(oc->fileName);
1130 stgFree(oc->symbols);
1131 stgFree(oc->sections);
1132 /* The local hash table should have been freed at the end
1133 of the ocResolve_ call on it. */
1134 ASSERT(oc->lochash == NULL);
1140 belch("unloadObj: can't find `%s' to unload", path);
1144 /* -----------------------------------------------------------------------------
1145 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1146 * which may be prodded during relocation, and abort if we try and write
1147 * outside any of these.
1149 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1152 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1153 /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1157 pb->next = oc->proddables;
1158 oc->proddables = pb;
1161 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1164 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1165 char* s = (char*)(pb->start);
1166 char* e = s + pb->size - 1;
1167 char* a = (char*)addr;
1168 /* Assumes that the biggest fixup involves a 4-byte write. This
1169 probably needs to be changed to 8 (ie, +7) on 64-bit
1171 if (a >= s && (a+3) <= e) return;
1173 barf("checkProddableBlock: invalid fixup in runtime linker");
1176 /* -----------------------------------------------------------------------------
1177 * Section management.
1179 static void addSection ( ObjectCode* oc, SectionKind kind,
1180 void* start, void* end )
1182 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1186 s->next = oc->sections;
1189 fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1190 start, ((char*)end)-1, end - start + 1, kind );
1196 /* --------------------------------------------------------------------------
1197 * PEi386 specifics (Win32 targets)
1198 * ------------------------------------------------------------------------*/
1200 /* The information for this linker comes from
1201 Microsoft Portable Executable
1202 and Common Object File Format Specification
1203 revision 5.1 January 1998
1204 which SimonM says comes from the MS Developer Network CDs.
1206 It can be found there (on older CDs), but can also be found
1209 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1211 (this is Rev 6.0 from February 1999).
1213 Things move, so if that fails, try searching for it via
1215 http://www.google.com/search?q=PE+COFF+specification
1217 The ultimate reference for the PE format is the Winnt.h
1218 header file that comes with the Platform SDKs; as always,
1219 implementations will drift wrt their documentation.
1221 A good background article on the PE format is Matt Pietrek's
1222 March 1994 article in Microsoft System Journal (MSJ)
1223 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1224 Win32 Portable Executable File Format." The info in there
1225 has recently been updated in a two part article in
1226 MSDN magazine, issues Feb and March 2002,
1227 "Inside Windows: An In-Depth Look into the Win32 Portable
1228 Executable File Format"
1230 John Levine's book "Linkers and Loaders" contains useful
1235 #if defined(OBJFORMAT_PEi386)
1239 typedef unsigned char UChar;
1240 typedef unsigned short UInt16;
1241 typedef unsigned int UInt32;
1248 UInt16 NumberOfSections;
1249 UInt32 TimeDateStamp;
1250 UInt32 PointerToSymbolTable;
1251 UInt32 NumberOfSymbols;
1252 UInt16 SizeOfOptionalHeader;
1253 UInt16 Characteristics;
1257 #define sizeof_COFF_header 20
1264 UInt32 VirtualAddress;
1265 UInt32 SizeOfRawData;
1266 UInt32 PointerToRawData;
1267 UInt32 PointerToRelocations;
1268 UInt32 PointerToLinenumbers;
1269 UInt16 NumberOfRelocations;
1270 UInt16 NumberOfLineNumbers;
1271 UInt32 Characteristics;
1275 #define sizeof_COFF_section 40
1282 UInt16 SectionNumber;
1285 UChar NumberOfAuxSymbols;
1289 #define sizeof_COFF_symbol 18
1294 UInt32 VirtualAddress;
1295 UInt32 SymbolTableIndex;
1300 #define sizeof_COFF_reloc 10
1303 /* From PE spec doc, section 3.3.2 */
1304 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1305 windows.h -- for the same purpose, but I want to know what I'm
1307 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1308 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1309 #define MYIMAGE_FILE_DLL 0x2000
1310 #define MYIMAGE_FILE_SYSTEM 0x1000
1311 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1312 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1313 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1315 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1316 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1317 #define MYIMAGE_SYM_CLASS_STATIC 3
1318 #define MYIMAGE_SYM_UNDEFINED 0
1320 /* From PE spec doc, section 4.1 */
1321 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1322 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1323 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1325 /* From PE spec doc, section 5.2.1 */
1326 #define MYIMAGE_REL_I386_DIR32 0x0006
1327 #define MYIMAGE_REL_I386_REL32 0x0014
1330 /* We use myindex to calculate array addresses, rather than
1331 simply doing the normal subscript thing. That's because
1332 some of the above structs have sizes which are not
1333 a whole number of words. GCC rounds their sizes up to a
1334 whole number of words, which means that the address calcs
1335 arising from using normal C indexing or pointer arithmetic
1336 are just plain wrong. Sigh.
1339 myindex ( int scale, void* base, int index )
1342 ((UChar*)base) + scale * index;
1347 printName ( UChar* name, UChar* strtab )
1349 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1350 UInt32 strtab_offset = * (UInt32*)(name+4);
1351 fprintf ( stderr, "%s", strtab + strtab_offset );
1354 for (i = 0; i < 8; i++) {
1355 if (name[i] == 0) break;
1356 fprintf ( stderr, "%c", name[i] );
1363 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1365 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1366 UInt32 strtab_offset = * (UInt32*)(name+4);
1367 strncpy ( dst, strtab+strtab_offset, dstSize );
1373 if (name[i] == 0) break;
1383 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1386 /* If the string is longer than 8 bytes, look in the
1387 string table for it -- this will be correctly zero terminated.
1389 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1390 UInt32 strtab_offset = * (UInt32*)(name+4);
1391 return ((UChar*)strtab) + strtab_offset;
1393 /* Otherwise, if shorter than 8 bytes, return the original,
1394 which by defn is correctly terminated.
1396 if (name[7]==0) return name;
1397 /* The annoying case: 8 bytes. Copy into a temporary
1398 (which is never freed ...)
1400 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1402 strncpy(newstr,name,8);
1408 /* Just compares the short names (first 8 chars) */
1409 static COFF_section *
1410 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1414 = (COFF_header*)(oc->image);
1415 COFF_section* sectab
1417 ((UChar*)(oc->image))
1418 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1420 for (i = 0; i < hdr->NumberOfSections; i++) {
1423 COFF_section* section_i
1425 myindex ( sizeof_COFF_section, sectab, i );
1426 n1 = (UChar*) &(section_i->Name);
1428 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1429 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1430 n1[6]==n2[6] && n1[7]==n2[7])
1439 zapTrailingAtSign ( UChar* sym )
1441 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1443 if (sym[0] == 0) return;
1445 while (sym[i] != 0) i++;
1448 while (j > 0 && my_isdigit(sym[j])) j--;
1449 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1455 ocVerifyImage_PEi386 ( ObjectCode* oc )
1460 COFF_section* sectab;
1461 COFF_symbol* symtab;
1463 /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1464 hdr = (COFF_header*)(oc->image);
1465 sectab = (COFF_section*) (
1466 ((UChar*)(oc->image))
1467 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1469 symtab = (COFF_symbol*) (
1470 ((UChar*)(oc->image))
1471 + hdr->PointerToSymbolTable
1473 strtab = ((UChar*)symtab)
1474 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1476 if (hdr->Machine != 0x14c) {
1477 belch("Not x86 PEi386");
1480 if (hdr->SizeOfOptionalHeader != 0) {
1481 belch("PEi386 with nonempty optional header");
1484 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1485 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1486 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1487 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1488 belch("Not a PEi386 object file");
1491 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1492 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1493 belch("Invalid PEi386 word size or endiannness: %d",
1494 (int)(hdr->Characteristics));
1497 /* If the string table size is way crazy, this might indicate that
1498 there are more than 64k relocations, despite claims to the
1499 contrary. Hence this test. */
1500 /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1502 if ( (*(UInt32*)strtab) > 600000 ) {
1503 /* Note that 600k has no special significance other than being
1504 big enough to handle the almost-2MB-sized lumps that
1505 constitute HSwin32*.o. */
1506 belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1511 /* No further verification after this point; only debug printing. */
1513 IF_DEBUG(linker, i=1);
1514 if (i == 0) return 1;
1517 "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1519 "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1521 "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1523 fprintf ( stderr, "\n" );
1525 "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1527 "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1529 "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1531 "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1533 "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1535 "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1537 "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1539 /* Print the section table. */
1540 fprintf ( stderr, "\n" );
1541 for (i = 0; i < hdr->NumberOfSections; i++) {
1543 COFF_section* sectab_i
1545 myindex ( sizeof_COFF_section, sectab, i );
1552 printName ( sectab_i->Name, strtab );
1562 sectab_i->VirtualSize,
1563 sectab_i->VirtualAddress,
1564 sectab_i->SizeOfRawData,
1565 sectab_i->PointerToRawData,
1566 sectab_i->NumberOfRelocations,
1567 sectab_i->PointerToRelocations,
1568 sectab_i->PointerToRawData
1570 reltab = (COFF_reloc*) (
1571 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1574 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1575 /* If the relocation field (a short) has overflowed, the
1576 * real count can be found in the first reloc entry.
1578 * See Section 4.1 (last para) of the PE spec (rev6.0).
1580 COFF_reloc* rel = (COFF_reloc*)
1581 myindex ( sizeof_COFF_reloc, reltab, 0 );
1582 noRelocs = rel->VirtualAddress;
1585 noRelocs = sectab_i->NumberOfRelocations;
1589 for (; j < noRelocs; j++) {
1591 COFF_reloc* rel = (COFF_reloc*)
1592 myindex ( sizeof_COFF_reloc, reltab, j );
1594 " type 0x%-4x vaddr 0x%-8x name `",
1596 rel->VirtualAddress );
1597 sym = (COFF_symbol*)
1598 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1599 /* Hmm..mysterious looking offset - what's it for? SOF */
1600 printName ( sym->Name, strtab -10 );
1601 fprintf ( stderr, "'\n" );
1604 fprintf ( stderr, "\n" );
1606 fprintf ( stderr, "\n" );
1607 fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1608 fprintf ( stderr, "---START of string table---\n");
1609 for (i = 4; i < *(Int32*)strtab; i++) {
1611 fprintf ( stderr, "\n"); else
1612 fprintf( stderr, "%c", strtab[i] );
1614 fprintf ( stderr, "--- END of string table---\n");
1616 fprintf ( stderr, "\n" );
1619 COFF_symbol* symtab_i;
1620 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1621 symtab_i = (COFF_symbol*)
1622 myindex ( sizeof_COFF_symbol, symtab, i );
1628 printName ( symtab_i->Name, strtab );
1637 (Int32)(symtab_i->SectionNumber),
1638 (UInt32)symtab_i->Type,
1639 (UInt32)symtab_i->StorageClass,
1640 (UInt32)symtab_i->NumberOfAuxSymbols
1642 i += symtab_i->NumberOfAuxSymbols;
1646 fprintf ( stderr, "\n" );
1652 ocGetNames_PEi386 ( ObjectCode* oc )
1655 COFF_section* sectab;
1656 COFF_symbol* symtab;
1663 hdr = (COFF_header*)(oc->image);
1664 sectab = (COFF_section*) (
1665 ((UChar*)(oc->image))
1666 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1668 symtab = (COFF_symbol*) (
1669 ((UChar*)(oc->image))
1670 + hdr->PointerToSymbolTable
1672 strtab = ((UChar*)(oc->image))
1673 + hdr->PointerToSymbolTable
1674 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1676 /* Allocate space for any (local, anonymous) .bss sections. */
1678 for (i = 0; i < hdr->NumberOfSections; i++) {
1680 COFF_section* sectab_i
1682 myindex ( sizeof_COFF_section, sectab, i );
1683 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1684 if (sectab_i->VirtualSize == 0) continue;
1685 /* This is a non-empty .bss section. Allocate zeroed space for
1686 it, and set its PointerToRawData field such that oc->image +
1687 PointerToRawData == addr_of_zeroed_space. */
1688 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1689 "ocGetNames_PEi386(anonymous bss)");
1690 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1691 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1692 /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1695 /* Copy section information into the ObjectCode. */
1697 for (i = 0; i < hdr->NumberOfSections; i++) {
1703 = SECTIONKIND_OTHER;
1704 COFF_section* sectab_i
1706 myindex ( sizeof_COFF_section, sectab, i );
1707 IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1710 /* I'm sure this is the Right Way to do it. However, the
1711 alternative of testing the sectab_i->Name field seems to
1712 work ok with Cygwin.
1714 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1715 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1716 kind = SECTIONKIND_CODE_OR_RODATA;
1719 if (0==strcmp(".text",sectab_i->Name) ||
1720 0==strcmp(".rodata",sectab_i->Name))
1721 kind = SECTIONKIND_CODE_OR_RODATA;
1722 if (0==strcmp(".data",sectab_i->Name) ||
1723 0==strcmp(".bss",sectab_i->Name))
1724 kind = SECTIONKIND_RWDATA;
1726 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1727 sz = sectab_i->SizeOfRawData;
1728 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1730 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1731 end = start + sz - 1;
1733 if (kind == SECTIONKIND_OTHER
1734 /* Ignore sections called which contain stabs debugging
1736 && 0 != strcmp(".stab", sectab_i->Name)
1737 && 0 != strcmp(".stabstr", sectab_i->Name)
1739 belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1743 if (kind != SECTIONKIND_OTHER && end >= start) {
1744 addSection(oc, kind, start, end);
1745 addProddableBlock(oc, start, end - start + 1);
1749 /* Copy exported symbols into the ObjectCode. */
1751 oc->n_symbols = hdr->NumberOfSymbols;
1752 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1753 "ocGetNames_PEi386(oc->symbols)");
1754 /* Call me paranoid; I don't care. */
1755 for (i = 0; i < oc->n_symbols; i++)
1756 oc->symbols[i] = NULL;
1760 COFF_symbol* symtab_i;
1761 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1762 symtab_i = (COFF_symbol*)
1763 myindex ( sizeof_COFF_symbol, symtab, i );
1767 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1768 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1769 /* This symbol is global and defined, viz, exported */
1770 /* for MYIMAGE_SYMCLASS_EXTERNAL
1771 && !MYIMAGE_SYM_UNDEFINED,
1772 the address of the symbol is:
1773 address of relevant section + offset in section
1775 COFF_section* sectabent
1776 = (COFF_section*) myindex ( sizeof_COFF_section,
1778 symtab_i->SectionNumber-1 );
1779 addr = ((UChar*)(oc->image))
1780 + (sectabent->PointerToRawData
1784 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1785 && symtab_i->Value > 0) {
1786 /* This symbol isn't in any section at all, ie, global bss.
1787 Allocate zeroed space for it. */
1788 addr = stgCallocBytes(1, symtab_i->Value,
1789 "ocGetNames_PEi386(non-anonymous bss)");
1790 addSection(oc, SECTIONKIND_RWDATA, addr,
1791 ((UChar*)addr) + symtab_i->Value - 1);
1792 addProddableBlock(oc, addr, symtab_i->Value);
1793 /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
1796 if (addr != NULL ) {
1797 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1798 /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
1799 IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1800 ASSERT(i >= 0 && i < oc->n_symbols);
1801 /* cstring_from_COFF_symbol_name always succeeds. */
1802 oc->symbols[i] = sname;
1803 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1807 "IGNORING symbol %d\n"
1811 printName ( symtab_i->Name, strtab );
1820 (Int32)(symtab_i->SectionNumber),
1821 (UInt32)symtab_i->Type,
1822 (UInt32)symtab_i->StorageClass,
1823 (UInt32)symtab_i->NumberOfAuxSymbols
1828 i += symtab_i->NumberOfAuxSymbols;
1837 ocResolve_PEi386 ( ObjectCode* oc )
1840 COFF_section* sectab;
1841 COFF_symbol* symtab;
1851 /* ToDo: should be variable-sized? But is at least safe in the
1852 sense of buffer-overrun-proof. */
1854 /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1856 hdr = (COFF_header*)(oc->image);
1857 sectab = (COFF_section*) (
1858 ((UChar*)(oc->image))
1859 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1861 symtab = (COFF_symbol*) (
1862 ((UChar*)(oc->image))
1863 + hdr->PointerToSymbolTable
1865 strtab = ((UChar*)(oc->image))
1866 + hdr->PointerToSymbolTable
1867 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1869 for (i = 0; i < hdr->NumberOfSections; i++) {
1870 COFF_section* sectab_i
1872 myindex ( sizeof_COFF_section, sectab, i );
1875 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1878 /* Ignore sections called which contain stabs debugging
1880 if (0 == strcmp(".stab", sectab_i->Name)
1881 || 0 == strcmp(".stabstr", sectab_i->Name))
1884 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1885 /* If the relocation field (a short) has overflowed, the
1886 * real count can be found in the first reloc entry.
1888 * See Section 4.1 (last para) of the PE spec (rev6.0).
1890 COFF_reloc* rel = (COFF_reloc*)
1891 myindex ( sizeof_COFF_reloc, reltab, 0 );
1892 noRelocs = rel->VirtualAddress;
1893 fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1896 noRelocs = sectab_i->NumberOfRelocations;
1901 for (; j < noRelocs; j++) {
1903 COFF_reloc* reltab_j
1905 myindex ( sizeof_COFF_reloc, reltab, j );
1907 /* the location to patch */
1909 ((UChar*)(oc->image))
1910 + (sectab_i->PointerToRawData
1911 + reltab_j->VirtualAddress
1912 - sectab_i->VirtualAddress )
1914 /* the existing contents of pP */
1916 /* the symbol to connect to */
1917 sym = (COFF_symbol*)
1918 myindex ( sizeof_COFF_symbol,
1919 symtab, reltab_j->SymbolTableIndex );
1922 "reloc sec %2d num %3d: type 0x%-4x "
1923 "vaddr 0x%-8x name `",
1925 (UInt32)reltab_j->Type,
1926 reltab_j->VirtualAddress );
1927 printName ( sym->Name, strtab );
1928 fprintf ( stderr, "'\n" ));
1930 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1931 COFF_section* section_sym
1932 = findPEi386SectionCalled ( oc, sym->Name );
1934 belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1937 S = ((UInt32)(oc->image))
1938 + (section_sym->PointerToRawData
1941 copyName ( sym->Name, strtab, symbol, 1000-1 );
1942 (void*)S = lookupLocalSymbol( oc, symbol );
1943 if ((void*)S != NULL) goto foundit;
1944 (void*)S = lookupSymbol( symbol );
1945 if ((void*)S != NULL) goto foundit;
1946 zapTrailingAtSign ( symbol );
1947 (void*)S = lookupLocalSymbol( oc, symbol );
1948 if ((void*)S != NULL) goto foundit;
1949 (void*)S = lookupSymbol( symbol );
1950 if ((void*)S != NULL) goto foundit;
1951 /* Newline first because the interactive linker has printed "linking..." */
1952 belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
1956 checkProddableBlock(oc, pP);
1957 switch (reltab_j->Type) {
1958 case MYIMAGE_REL_I386_DIR32:
1961 case MYIMAGE_REL_I386_REL32:
1962 /* Tricky. We have to insert a displacement at
1963 pP which, when added to the PC for the _next_
1964 insn, gives the address of the target (S).
1965 Problem is to know the address of the next insn
1966 when we only know pP. We assume that this
1967 literal field is always the last in the insn,
1968 so that the address of the next insn is pP+4
1969 -- hence the constant 4.
1970 Also I don't know if A should be added, but so
1971 far it has always been zero.
1974 *pP = S - ((UInt32)pP) - 4;
1977 belch("%s: unhandled PEi386 relocation type %d",
1978 oc->fileName, reltab_j->Type);
1985 IF_DEBUG(linker, belch("completed %s", oc->fileName));
1989 #endif /* defined(OBJFORMAT_PEi386) */
1992 /* --------------------------------------------------------------------------
1994 * ------------------------------------------------------------------------*/
1996 #if defined(OBJFORMAT_ELF)
2001 #if defined(sparc_TARGET_ARCH)
2002 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2003 #elif defined(i386_TARGET_ARCH)
2004 # define ELF_TARGET_386 /* Used inside <elf.h> */
2005 #elif defined (ia64_TARGET_ARCH)
2006 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2008 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2009 # define ELF_NEED_GOT /* needs Global Offset Table */
2010 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2016 * Define a set of types which can be used for both ELF32 and ELF64
2020 #define ELFCLASS ELFCLASS64
2021 #define Elf_Addr Elf64_Addr
2022 #define Elf_Word Elf64_Word
2023 #define Elf_Sword Elf64_Sword
2024 #define Elf_Ehdr Elf64_Ehdr
2025 #define Elf_Phdr Elf64_Phdr
2026 #define Elf_Shdr Elf64_Shdr
2027 #define Elf_Sym Elf64_Sym
2028 #define Elf_Rel Elf64_Rel
2029 #define Elf_Rela Elf64_Rela
2030 #define ELF_ST_TYPE ELF64_ST_TYPE
2031 #define ELF_ST_BIND ELF64_ST_BIND
2032 #define ELF_R_TYPE ELF64_R_TYPE
2033 #define ELF_R_SYM ELF64_R_SYM
2035 #define ELFCLASS ELFCLASS32
2036 #define Elf_Addr Elf32_Addr
2037 #define Elf_Word Elf32_Word
2038 #define Elf_Sword Elf32_Sword
2039 #define Elf_Ehdr Elf32_Ehdr
2040 #define Elf_Phdr Elf32_Phdr
2041 #define Elf_Shdr Elf32_Shdr
2042 #define Elf_Sym Elf32_Sym
2043 #define Elf_Rel Elf32_Rel
2044 #define Elf_Rela Elf32_Rela
2046 #define ELF_ST_TYPE ELF32_ST_TYPE
2049 #define ELF_ST_BIND ELF32_ST_BIND
2052 #define ELF_R_TYPE ELF32_R_TYPE
2055 #define ELF_R_SYM ELF32_R_SYM
2061 * Functions to allocate entries in dynamic sections. Currently we simply
2062 * preallocate a large number, and we don't check if a entry for the given
2063 * target already exists (a linear search is too slow). Ideally these
2064 * entries would be associated with symbols.
2067 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2068 #define GOT_SIZE 0x20000
2069 #define FUNCTION_TABLE_SIZE 0x10000
2070 #define PLT_SIZE 0x08000
2073 static Elf_Addr got[GOT_SIZE];
2074 static unsigned int gotIndex;
2075 static Elf_Addr gp_val = (Elf_Addr)got;
2078 allocateGOTEntry(Elf_Addr target)
2082 if (gotIndex >= GOT_SIZE)
2083 barf("Global offset table overflow");
2085 entry = &got[gotIndex++];
2087 return (Elf_Addr)entry;
2091 #ifdef ELF_FUNCTION_DESC
2097 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2098 static unsigned int functionTableIndex;
2101 allocateFunctionDesc(Elf_Addr target)
2103 FunctionDesc *entry;
2105 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2106 barf("Function table overflow");
2108 entry = &functionTable[functionTableIndex++];
2110 entry->gp = (Elf_Addr)gp_val;
2111 return (Elf_Addr)entry;
2115 copyFunctionDesc(Elf_Addr target)
2117 FunctionDesc *olddesc = (FunctionDesc *)target;
2118 FunctionDesc *newdesc;
2120 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2121 newdesc->gp = olddesc->gp;
2122 return (Elf_Addr)newdesc;
2127 #ifdef ia64_TARGET_ARCH
2128 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2129 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2131 static unsigned char plt_code[] =
2133 /* taken from binutils bfd/elfxx-ia64.c */
2134 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2135 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2136 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2137 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2138 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2139 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2142 /* If we can't get to the function descriptor via gp, take a local copy of it */
2143 #define PLT_RELOC(code, target) { \
2144 Elf64_Sxword rel_value = target - gp_val; \
2145 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2146 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2148 ia64_reloc_gprel22((Elf_Addr)code, target); \
2153 unsigned char code[sizeof(plt_code)];
2157 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2159 PLTEntry *plt = (PLTEntry *)oc->plt;
2162 if (oc->pltIndex >= PLT_SIZE)
2163 barf("Procedure table overflow");
2165 entry = &plt[oc->pltIndex++];
2166 memcpy(entry->code, plt_code, sizeof(entry->code));
2167 PLT_RELOC(entry->code, target);
2168 return (Elf_Addr)entry;
2174 return (PLT_SIZE * sizeof(PLTEntry));
2180 * Generic ELF functions
2184 findElfSection ( void* objImage, Elf_Word sh_type )
2186 char* ehdrC = (char*)objImage;
2187 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2188 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2189 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2193 for (i = 0; i < ehdr->e_shnum; i++) {
2194 if (shdr[i].sh_type == sh_type
2195 /* Ignore the section header's string table. */
2196 && i != ehdr->e_shstrndx
2197 /* Ignore string tables named .stabstr, as they contain
2199 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2201 ptr = ehdrC + shdr[i].sh_offset;
2208 #if defined(ia64_TARGET_ARCH)
2210 findElfSegment ( void* objImage, Elf_Addr vaddr )
2212 char* ehdrC = (char*)objImage;
2213 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2214 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2215 Elf_Addr segaddr = 0;
2218 for (i = 0; i < ehdr->e_phnum; i++) {
2219 segaddr = phdr[i].p_vaddr;
2220 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2228 ocVerifyImage_ELF ( ObjectCode* oc )
2232 int i, j, nent, nstrtab, nsymtabs;
2236 char* ehdrC = (char*)(oc->image);
2237 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2239 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2240 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2241 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2242 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2243 belch("%s: not an ELF object", oc->fileName);
2247 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2248 belch("%s: unsupported ELF format", oc->fileName);
2252 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2253 IF_DEBUG(linker,belch( "Is little-endian" ));
2255 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2256 IF_DEBUG(linker,belch( "Is big-endian" ));
2258 belch("%s: unknown endiannness", oc->fileName);
2262 if (ehdr->e_type != ET_REL) {
2263 belch("%s: not a relocatable object (.o) file", oc->fileName);
2266 IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2268 IF_DEBUG(linker,belch( "Architecture is " ));
2269 switch (ehdr->e_machine) {
2270 case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
2271 case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2273 case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2275 default: IF_DEBUG(linker,belch( "unknown" ));
2276 belch("%s: unknown architecture", oc->fileName);
2280 IF_DEBUG(linker,belch(
2281 "\nSection header table: start %d, n_entries %d, ent_size %d",
2282 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2284 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2286 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2288 if (ehdr->e_shstrndx == SHN_UNDEF) {
2289 belch("%s: no section header string table", oc->fileName);
2292 IF_DEBUG(linker,belch( "Section header string table is section %d",
2294 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2297 for (i = 0; i < ehdr->e_shnum; i++) {
2298 IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
2299 IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
2300 IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
2301 IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
2302 IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
2303 ehdrC + shdr[i].sh_offset,
2304 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2306 if (shdr[i].sh_type == SHT_REL) {
2307 IF_DEBUG(linker,fprintf(stderr, "Rel " ));
2308 } else if (shdr[i].sh_type == SHT_RELA) {
2309 IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2311 IF_DEBUG(linker,fprintf(stderr," "));
2314 IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2318 IF_DEBUG(linker,belch( "\nString tables" ));
2321 for (i = 0; i < ehdr->e_shnum; i++) {
2322 if (shdr[i].sh_type == SHT_STRTAB
2323 /* Ignore the section header's string table. */
2324 && i != ehdr->e_shstrndx
2325 /* Ignore string tables named .stabstr, as they contain
2327 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2329 IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
2330 strtab = ehdrC + shdr[i].sh_offset;
2335 belch("%s: no string tables, or too many", oc->fileName);
2340 IF_DEBUG(linker,belch( "\nSymbol tables" ));
2341 for (i = 0; i < ehdr->e_shnum; i++) {
2342 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2343 IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2345 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2346 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2347 IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
2349 shdr[i].sh_size % sizeof(Elf_Sym)
2351 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2352 belch("%s: non-integral number of symbol table entries", oc->fileName);
2355 for (j = 0; j < nent; j++) {
2356 IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
2357 IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
2358 (int)stab[j].st_shndx,
2359 (int)stab[j].st_size,
2360 (char*)stab[j].st_value ));
2362 IF_DEBUG(linker,fprintf(stderr, "type=" ));
2363 switch (ELF_ST_TYPE(stab[j].st_info)) {
2364 case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2365 case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2366 case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
2367 case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2368 case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
2369 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2371 IF_DEBUG(linker,fprintf(stderr, " " ));
2373 IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2374 switch (ELF_ST_BIND(stab[j].st_info)) {
2375 case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2376 case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2377 case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
2378 default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
2380 IF_DEBUG(linker,fprintf(stderr, " " ));
2382 IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2386 if (nsymtabs == 0) {
2387 belch("%s: didn't find any symbol tables", oc->fileName);
2396 ocGetNames_ELF ( ObjectCode* oc )
2401 char* ehdrC = (char*)(oc->image);
2402 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2403 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2404 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2406 ASSERT(symhash != NULL);
2409 belch("%s: no strtab", oc->fileName);
2414 for (i = 0; i < ehdr->e_shnum; i++) {
2415 /* Figure out what kind of section it is. Logic derived from
2416 Figure 1.14 ("Special Sections") of the ELF document
2417 ("Portable Formats Specification, Version 1.1"). */
2418 Elf_Shdr hdr = shdr[i];
2419 SectionKind kind = SECTIONKIND_OTHER;
2422 if (hdr.sh_type == SHT_PROGBITS
2423 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2424 /* .text-style section */
2425 kind = SECTIONKIND_CODE_OR_RODATA;
2428 if (hdr.sh_type == SHT_PROGBITS
2429 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2430 /* .data-style section */
2431 kind = SECTIONKIND_RWDATA;
2434 if (hdr.sh_type == SHT_PROGBITS
2435 && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2436 /* .rodata-style section */
2437 kind = SECTIONKIND_CODE_OR_RODATA;
2440 if (hdr.sh_type == SHT_NOBITS
2441 && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2442 /* .bss-style section */
2443 kind = SECTIONKIND_RWDATA;
2447 if (is_bss && shdr[i].sh_size > 0) {
2448 /* This is a non-empty .bss section. Allocate zeroed space for
2449 it, and set its .sh_offset field such that
2450 ehdrC + .sh_offset == addr_of_zeroed_space. */
2451 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2452 "ocGetNames_ELF(BSS)");
2453 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2455 fprintf(stderr, "BSS section at 0x%x, size %d\n",
2456 zspace, shdr[i].sh_size);
2460 /* fill in the section info */
2461 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2462 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2463 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2464 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2467 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2469 /* copy stuff into this module's object symbol table */
2470 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2471 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2473 oc->n_symbols = nent;
2474 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2475 "ocGetNames_ELF(oc->symbols)");
2477 for (j = 0; j < nent; j++) {
2479 char isLocal = FALSE; /* avoids uninit-var warning */
2481 char* nm = strtab + stab[j].st_name;
2482 int secno = stab[j].st_shndx;
2484 /* Figure out if we want to add it; if so, set ad to its
2485 address. Otherwise leave ad == NULL. */
2487 if (secno == SHN_COMMON) {
2489 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2491 fprintf(stderr, "COMMON symbol, size %d name %s\n",
2492 stab[j].st_size, nm);
2494 /* Pointless to do addProddableBlock() for this area,
2495 since the linker should never poke around in it. */
2498 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2499 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2501 /* and not an undefined symbol */
2502 && stab[j].st_shndx != SHN_UNDEF
2503 /* and not in a "special section" */
2504 && stab[j].st_shndx < SHN_LORESERVE
2506 /* and it's a not a section or string table or anything silly */
2507 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2508 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2509 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2512 /* Section 0 is the undefined section, hence > and not >=. */
2513 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2515 if (shdr[secno].sh_type == SHT_NOBITS) {
2516 fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
2517 stab[j].st_size, stab[j].st_value, nm);
2520 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2521 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2524 #ifdef ELF_FUNCTION_DESC
2525 /* dlsym() and the initialisation table both give us function
2526 * descriptors, so to be consistent we store function descriptors
2527 * in the symbol table */
2528 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2529 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2531 IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
2532 ad, oc->fileName, nm ));
2537 /* And the decision is ... */
2541 oc->symbols[j] = nm;
2544 /* Ignore entirely. */
2546 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2550 IF_DEBUG(linker,belch( "skipping `%s'",
2551 strtab + stab[j].st_name ));
2554 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2555 (int)ELF_ST_BIND(stab[j].st_info),
2556 (int)ELF_ST_TYPE(stab[j].st_info),
2557 (int)stab[j].st_shndx,
2558 strtab + stab[j].st_name
2561 oc->symbols[j] = NULL;
2570 /* Do ELF relocations which lack an explicit addend. All x86-linux
2571 relocations appear to be of this form. */
2573 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2574 Elf_Shdr* shdr, int shnum,
2575 Elf_Sym* stab, char* strtab )
2580 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2581 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2582 int target_shndx = shdr[shnum].sh_info;
2583 int symtab_shndx = shdr[shnum].sh_link;
2585 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2586 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2587 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2588 target_shndx, symtab_shndx ));
2590 for (j = 0; j < nent; j++) {
2591 Elf_Addr offset = rtab[j].r_offset;
2592 Elf_Addr info = rtab[j].r_info;
2594 Elf_Addr P = ((Elf_Addr)targ) + offset;
2595 Elf_Word* pP = (Elf_Word*)P;
2600 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2601 j, (void*)offset, (void*)info ));
2603 IF_DEBUG(linker,belch( " ZERO" ));
2606 Elf_Sym sym = stab[ELF_R_SYM(info)];
2607 /* First see if it is a local symbol. */
2608 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2609 /* Yes, so we can get the address directly from the ELF symbol
2611 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2613 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2614 + stab[ELF_R_SYM(info)].st_value);
2617 /* No, so look up the name in our global table. */
2618 symbol = strtab + sym.st_name;
2619 (void*)S = lookupSymbol( symbol );
2622 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2625 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2628 IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
2629 (void*)P, (void*)S, (void*)A ));
2630 checkProddableBlock ( oc, pP );
2634 switch (ELF_R_TYPE(info)) {
2635 # ifdef i386_TARGET_ARCH
2636 case R_386_32: *pP = value; break;
2637 case R_386_PC32: *pP = value - P; break;
2640 belch("%s: unhandled ELF relocation(Rel) type %d\n",
2641 oc->fileName, ELF_R_TYPE(info));
2649 /* Do ELF relocations for which explicit addends are supplied.
2650 sparc-solaris relocations appear to be of this form. */
2652 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2653 Elf_Shdr* shdr, int shnum,
2654 Elf_Sym* stab, char* strtab )
2659 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2660 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2661 int target_shndx = shdr[shnum].sh_info;
2662 int symtab_shndx = shdr[shnum].sh_link;
2664 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2665 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2666 IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2667 target_shndx, symtab_shndx ));
2669 for (j = 0; j < nent; j++) {
2670 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2671 /* This #ifdef only serves to avoid unused-var warnings. */
2672 Elf_Addr offset = rtab[j].r_offset;
2673 Elf_Addr P = targ + offset;
2675 Elf_Addr info = rtab[j].r_info;
2676 Elf_Addr A = rtab[j].r_addend;
2679 # if defined(sparc_TARGET_ARCH)
2680 Elf_Word* pP = (Elf_Word*)P;
2682 # elif defined(ia64_TARGET_ARCH)
2683 Elf64_Xword *pP = (Elf64_Xword *)P;
2687 IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
2688 j, (void*)offset, (void*)info,
2691 IF_DEBUG(linker,belch( " ZERO" ));
2694 Elf_Sym sym = stab[ELF_R_SYM(info)];
2695 /* First see if it is a local symbol. */
2696 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2697 /* Yes, so we can get the address directly from the ELF symbol
2699 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2701 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2702 + stab[ELF_R_SYM(info)].st_value);
2703 #ifdef ELF_FUNCTION_DESC
2704 /* Make a function descriptor for this function */
2705 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2706 S = allocateFunctionDesc(S + A);
2711 /* No, so look up the name in our global table. */
2712 symbol = strtab + sym.st_name;
2713 (void*)S = lookupSymbol( symbol );
2715 #ifdef ELF_FUNCTION_DESC
2716 /* If a function, already a function descriptor - we would
2717 have to copy it to add an offset. */
2718 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
2719 belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
2723 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2726 IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2729 IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
2730 (void*)P, (void*)S, (void*)A ));
2731 /* checkProddableBlock ( oc, (void*)P ); */
2735 switch (ELF_R_TYPE(info)) {
2736 # if defined(sparc_TARGET_ARCH)
2737 case R_SPARC_WDISP30:
2738 w1 = *pP & 0xC0000000;
2739 w2 = (Elf_Word)((value - P) >> 2);
2740 ASSERT((w2 & 0xC0000000) == 0);
2745 w1 = *pP & 0xFFC00000;
2746 w2 = (Elf_Word)(value >> 10);
2747 ASSERT((w2 & 0xFFC00000) == 0);
2753 w2 = (Elf_Word)(value & 0x3FF);
2754 ASSERT((w2 & ~0x3FF) == 0);
2758 /* According to the Sun documentation:
2760 This relocation type resembles R_SPARC_32, except it refers to an
2761 unaligned word. That is, the word to be relocated must be treated
2762 as four separate bytes with arbitrary alignment, not as a word
2763 aligned according to the architecture requirements.
2765 (JRS: which means that freeloading on the R_SPARC_32 case
2766 is probably wrong, but hey ...)
2770 w2 = (Elf_Word)value;
2773 # elif defined(ia64_TARGET_ARCH)
2774 case R_IA64_DIR64LSB:
2775 case R_IA64_FPTR64LSB:
2778 case R_IA64_PCREL64LSB:
2781 case R_IA64_SEGREL64LSB:
2782 addr = findElfSegment(ehdrC, value);
2785 case R_IA64_GPREL22:
2786 ia64_reloc_gprel22(P, value);
2788 case R_IA64_LTOFF22:
2789 case R_IA64_LTOFF22X:
2790 case R_IA64_LTOFF_FPTR22:
2791 addr = allocateGOTEntry(value);
2792 ia64_reloc_gprel22(P, addr);
2794 case R_IA64_PCREL21B:
2795 ia64_reloc_pcrel21(P, S, oc);
2798 /* This goes with R_IA64_LTOFF22X and points to the load to
2799 * convert into a move. We don't implement relaxation. */
2803 belch("%s: unhandled ELF relocation(RelA) type %d\n",
2804 oc->fileName, ELF_R_TYPE(info));
2813 ocResolve_ELF ( ObjectCode* oc )
2817 Elf_Sym* stab = NULL;
2818 char* ehdrC = (char*)(oc->image);
2819 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
2820 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2821 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2823 /* first find "the" symbol table */
2824 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2826 /* also go find the string table */
2827 strtab = findElfSection ( ehdrC, SHT_STRTAB );
2829 if (stab == NULL || strtab == NULL) {
2830 belch("%s: can't find string or symbol table", oc->fileName);
2834 /* Process the relocation sections. */
2835 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2837 /* Skip sections called ".rel.stab". These appear to contain
2838 relocation entries that, when done, make the stabs debugging
2839 info point at the right places. We ain't interested in all
2841 if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2844 if (shdr[shnum].sh_type == SHT_REL ) {
2845 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2846 shnum, stab, strtab );
2850 if (shdr[shnum].sh_type == SHT_RELA) {
2851 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2852 shnum, stab, strtab );
2857 /* Free the local symbol table; we won't need it again. */
2858 freeHashTable(oc->lochash, NULL);
2866 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2867 * at the front. The following utility functions pack and unpack instructions, and
2868 * take care of the most common relocations.
2871 #ifdef ia64_TARGET_ARCH
2874 ia64_extract_instruction(Elf64_Xword *target)
2877 int slot = (Elf_Addr)target & 3;
2878 (Elf_Addr)target &= ~3;
2886 return ((w1 >> 5) & 0x1ffffffffff);
2888 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2892 barf("ia64_extract_instruction: invalid slot %p", target);
2897 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2899 int slot = (Elf_Addr)target & 3;
2900 (Elf_Addr)target &= ~3;
2905 *target |= value << 5;
2908 *target |= value << 46;
2909 *(target+1) |= value >> 18;
2912 *(target+1) |= value << 23;
2918 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2920 Elf64_Xword instruction;
2921 Elf64_Sxword rel_value;
2923 rel_value = value - gp_val;
2924 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2925 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2927 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2928 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
2929 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
2930 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
2931 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2932 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2936 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2938 Elf64_Xword instruction;
2939 Elf64_Sxword rel_value;
2942 entry = allocatePLTEntry(value, oc);
2944 rel_value = (entry >> 4) - (target >> 4);
2945 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2946 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2948 instruction = ia64_extract_instruction((Elf64_Xword *)target);
2949 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
2950 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
2951 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2958 /* --------------------------------------------------------------------------
2960 * ------------------------------------------------------------------------*/
2962 #if defined(OBJFORMAT_MACHO)
2965 Initial support for MachO linking on Darwin/MacOS X on PowerPC chips
2966 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
2968 I hereby formally apologize for the hackish nature of this code.
2969 Things that need to be done:
2970 *) get common symbols and .bss sections to work properly.
2971 Haskell modules seem to work, but C modules can cause problems
2972 *) implement ocVerifyImage_MachO
2973 *) add more sanity checks. The current code just has to segfault if there's a
2977 static int ocVerifyImage_MachO(ObjectCode* oc)
2979 // FIXME: do some verifying here
2983 static int resolveImports(
2986 struct symtab_command *symLC,
2987 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
2988 unsigned long *indirectSyms,
2989 struct nlist *nlist)
2993 for(i=0;i*4<sect->size;i++)
2995 // according to otool, reserved1 contains the first index into the indirect symbol table
2996 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
2997 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3000 if((symbol->n_type & N_TYPE) == N_UNDF
3001 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3002 addr = (void*) (symbol->n_value);
3003 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3006 addr = lookupSymbol(nm);
3009 belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3013 ((void**)(image + sect->offset))[i] = addr;
3019 static int relocateSection(char *image,
3020 struct symtab_command *symLC, struct nlist *nlist,
3021 struct section* sections, struct section *sect)
3023 struct relocation_info *relocs;
3026 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3028 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3032 relocs = (struct relocation_info*) (image + sect->reloff);
3036 if(relocs[i].r_address & R_SCATTERED)
3038 struct scattered_relocation_info *scat =
3039 (struct scattered_relocation_info*) &relocs[i];
3043 if(scat->r_length == 2 && scat->r_type == GENERIC_RELOC_VANILLA)
3045 unsigned long* word = (unsigned long*) (image + sect->offset + scat->r_address);
3047 *word = scat->r_value + sect->offset + ((long) image);
3051 continue; // FIXME: I hope it's OK to ignore all the others.
3055 struct relocation_info *reloc = &relocs[i];
3056 if(reloc->r_pcrel && !reloc->r_extern)
3059 if(reloc->r_length == 2)
3061 unsigned long word = 0;
3063 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3065 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3069 else if(reloc->r_type == PPC_RELOC_LO16)
3071 word = ((unsigned short*) wordPtr)[1];
3072 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3074 else if(reloc->r_type == PPC_RELOC_HI16)
3076 word = ((unsigned short*) wordPtr)[1] << 16;
3077 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3079 else if(reloc->r_type == PPC_RELOC_HA16)
3081 word = ((unsigned short*) wordPtr)[1] << 16;
3082 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3084 else if(reloc->r_type == PPC_RELOC_BR24)
3087 word = (word & 0x03FFFFFC) | (word & 0x02000000) ? 0xFC000000 : 0;
3091 if(!reloc->r_extern)
3094 sections[reloc->r_symbolnum-1].offset
3095 - sections[reloc->r_symbolnum-1].addr
3102 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3103 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3104 word = (unsigned long) (lookupSymbol(nm));
3107 belch("\nunknown symbol `%s'", nm);
3112 word -= ((long)image) + sect->offset + reloc->r_address;
3115 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3120 else if(reloc->r_type == PPC_RELOC_LO16)
3122 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3125 else if(reloc->r_type == PPC_RELOC_HI16)
3127 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3130 else if(reloc->r_type == PPC_RELOC_HA16)
3132 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3133 + ((word & (1<<15)) ? 1 : 0);
3136 else if(reloc->r_type == PPC_RELOC_BR24)
3138 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
3142 barf("\nunknown relocation %d",reloc->r_type);
3149 static int ocGetNames_MachO(ObjectCode* oc)
3151 char *image = (char*) oc->image;
3152 struct mach_header *header = (struct mach_header*) image;
3153 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3154 unsigned i,curSymbol;
3155 struct segment_command *segLC = NULL;
3156 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3157 struct symtab_command *symLC = NULL;
3158 struct dysymtab_command *dsymLC = NULL;
3159 struct nlist *nlist;
3160 unsigned long commonSize = 0;
3161 char *commonStorage = NULL;
3162 unsigned long commonCounter;
3164 for(i=0;i<header->ncmds;i++)
3166 if(lc->cmd == LC_SEGMENT)
3167 segLC = (struct segment_command*) lc;
3168 else if(lc->cmd == LC_SYMTAB)
3169 symLC = (struct symtab_command*) lc;
3170 else if(lc->cmd == LC_DYSYMTAB)
3171 dsymLC = (struct dysymtab_command*) lc;
3172 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3175 sections = (struct section*) (segLC+1);
3176 nlist = (struct nlist*) (image + symLC->symoff);
3178 for(i=0;i<segLC->nsects;i++)
3180 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3181 la_ptrs = §ions[i];
3182 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3183 nl_ptrs = §ions[i];
3185 // for now, only add __text and __const to the sections table
3186 else if(!strcmp(sections[i].sectname,"__text"))
3187 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
3188 (void*) (image + sections[i].offset),
3189 (void*) (image + sections[i].offset + sections[i].size));
3190 else if(!strcmp(sections[i].sectname,"__const"))
3191 addSection(oc, SECTIONKIND_RWDATA,
3192 (void*) (image + sections[i].offset),
3193 (void*) (image + sections[i].offset + sections[i].size));
3194 else if(!strcmp(sections[i].sectname,"__data"))
3195 addSection(oc, SECTIONKIND_RWDATA,
3196 (void*) (image + sections[i].offset),
3197 (void*) (image + sections[i].offset + sections[i].size));
3200 // count external symbols defined here
3202 for(i=dsymLC->iextdefsym;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3204 if((nlist[i].n_type & N_TYPE) == N_SECT)
3207 for(i=0;i<symLC->nsyms;i++)
3209 if((nlist[i].n_type & N_TYPE) == N_UNDF
3210 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3212 commonSize += nlist[i].n_value;
3216 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3217 "ocGetNames_MachO(oc->symbols)");
3219 // insert symbols into hash table
3220 for(i=dsymLC->iextdefsym,curSymbol=0;i<dsymLC->iextdefsym+dsymLC->nextdefsym;i++)
3222 if((nlist[i].n_type & N_TYPE) == N_SECT)
3224 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3225 ghciInsertStrHashTable(oc->fileName, symhash, nm, image +
3226 sections[nlist[i].n_sect-1].offset
3227 - sections[nlist[i].n_sect-1].addr
3228 + nlist[i].n_value);
3229 oc->symbols[curSymbol++] = nm;
3233 // insert local symbols into lochash
3234 for(i=dsymLC->ilocalsym;i<dsymLC->ilocalsym+dsymLC->nlocalsym;i++)
3236 if((nlist[i].n_type & N_TYPE) == N_SECT)
3238 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3239 ghciInsertStrHashTable(oc->fileName, oc->lochash, nm, image +
3240 sections[nlist[i].n_sect-1].offset
3241 - sections[nlist[i].n_sect-1].addr
3242 + nlist[i].n_value);
3247 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
3248 commonCounter = (unsigned long)commonStorage;
3249 for(i=0;i<symLC->nsyms;i++)
3251 if((nlist[i].n_type & N_TYPE) == N_UNDF
3252 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
3254 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
3255 unsigned long sz = nlist[i].n_value;
3257 nlist[i].n_value = commonCounter;
3259 ghciInsertStrHashTable(oc->fileName, symhash, nm, (void*)commonCounter);
3260 oc->symbols[curSymbol++] = nm;
3262 commonCounter += sz;
3268 static int ocResolve_MachO(ObjectCode* oc)
3270 char *image = (char*) oc->image;
3271 struct mach_header *header = (struct mach_header*) image;
3272 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
3274 struct segment_command *segLC = NULL;
3275 struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
3276 struct symtab_command *symLC = NULL;
3277 struct dysymtab_command *dsymLC = NULL;
3278 struct nlist *nlist;
3279 unsigned long *indirectSyms;
3281 for(i=0;i<header->ncmds;i++)
3283 if(lc->cmd == LC_SEGMENT)
3284 segLC = (struct segment_command*) lc;
3285 else if(lc->cmd == LC_SYMTAB)
3286 symLC = (struct symtab_command*) lc;
3287 else if(lc->cmd == LC_DYSYMTAB)
3288 dsymLC = (struct dysymtab_command*) lc;
3289 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
3292 sections = (struct section*) (segLC+1);
3293 nlist = (struct nlist*) (image + symLC->symoff);
3295 for(i=0;i<segLC->nsects;i++)
3297 if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
3298 la_ptrs = §ions[i];
3299 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
3300 nl_ptrs = §ions[i];
3303 indirectSyms = (unsigned long*) (image + dsymLC->indirectsymoff);
3306 if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
3309 if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
3312 for(i=0;i<segLC->nsects;i++)
3314 if(!relocateSection(image,symLC,nlist,sections,§ions[i]))
3318 /* Free the local symbol table; we won't need it again. */
3319 freeHashTable(oc->lochash, NULL);
3325 * The Mach-O object format uses leading underscores. But not everywhere.
3326 * There is a small number of runtime support functions defined in
3327 * libcc_dynamic.a whose name does not have a leading underscore.
3328 * As a consequence, we can't get their address from C code.
3329 * We have to use inline assembler just to take the address of a function.
3333 static void machoInitSymbolsWithoutUnderscore()
3339 __asm__ ("lis %0,hi16(" #x ")\n\tori %0,%0,lo16(" #x ")" : "=r" (p)); \
3340 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, p);
3342 RTS_MACHO_NOUNDERLINE_SYMBOLS