rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team, 2000-2004
   4  *
   5  * RTS Object Linker
   6  *
   7  * ---------------------------------------------------------------------------*/
   8
   9 #if 0
  10 #include "PosixSource.h"
  11 #endif
  12
  13 /* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
  14    MREMAP_MAYMOVE from <sys/mman.h>.
  15  */
  16 #ifdef __linux__
  17 #define _GNU_SOURCE
  18 #endif
  19
  20 #include "Rts.h"
  21 #include "RtsFlags.h"
  22 #include "HsFFI.h"
  23 #include "Hash.h"
  24 #include "Linker.h"
  25 #include "LinkerInternals.h"
  26 #include "RtsUtils.h"
  27 #include "Schedule.h"
  28 #include "Sparks.h"
  29 #include "RtsTypeable.h"
  30 #include "Timer.h"
  31
  32 #ifdef HAVE_SYS_TYPES_H
  33 #include <sys/types.h>
  34 #endif
  35
  36 #include <stdlib.h>
  37 #include <string.h>
  38
  39 #ifdef HAVE_SYS_STAT_H
  40 #include <sys/stat.h>
  41 #endif
  42
  43 #if defined(HAVE_DLFCN_H)
  44 #include <dlfcn.h>
  45 #endif
  46
  47 #if defined(cygwin32_HOST_OS)
  48 #ifdef HAVE_DIRENT_H
  49 #include <dirent.h>
  50 #endif
  51
  52 #ifdef HAVE_SYS_TIME_H
  53 #include <sys/time.h>
  54 #endif
  55 #include <regex.h>
  56 #include <sys/fcntl.h>
  57 #include <sys/termios.h>
  58 #include <sys/utime.h>
  59 #include <sys/utsname.h>
  60 #include <sys/wait.h>
  61 #endif
  62
  63 #if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
  64 #define USE_MMAP
  65 #include <fcntl.h>
  66 #include <sys/mman.h>
  67
  68 #if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
  69 #ifdef HAVE_UNISTD_H
  70 #include <unistd.h>
  71 #endif
  72 #endif
  73
  74 #endif
  75
  76 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
  77 #  define OBJFORMAT_ELF
  78 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
  79 #  define OBJFORMAT_PEi386
  80 #  include <windows.h>
  81 #  include <math.h>
  82 #elif defined(darwin_HOST_OS)
  83 #  define OBJFORMAT_MACHO
  84 #  include <mach-o/loader.h>
  85 #  include <mach-o/nlist.h>
  86 #  include <mach-o/reloc.h>
  87 #if !defined(HAVE_DLFCN_H)
  88 #  include <mach-o/dyld.h>
  89 #endif
  90 #if defined(powerpc_HOST_ARCH)
  91 #  include <mach-o/ppc/reloc.h>
  92 #endif
  93 #if defined(x86_64_HOST_ARCH)
  94 #  include <mach-o/x86_64/reloc.h>
  95 #endif
  96 #endif
  97
  98 /* Hash table mapping symbol names to Symbol */
  99 static /*Str*/HashTable *symhash;
 100
 101 /* Hash table mapping symbol names to StgStablePtr */
 102 static /*Str*/HashTable *stablehash;
 103
 104 /* List of currently loaded objects */
 105 ObjectCode *objects = NULL;     /* initially empty */
 106
 107 #if defined(OBJFORMAT_ELF)
 108 static int ocVerifyImage_ELF    ( ObjectCode* oc );
 109 static int ocGetNames_ELF       ( ObjectCode* oc );
 110 static int ocResolve_ELF        ( ObjectCode* oc );
 111 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
 112 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
 113 #endif
 114 #elif defined(OBJFORMAT_PEi386)
 115 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
 116 static int ocGetNames_PEi386    ( ObjectCode* oc );
 117 static int ocResolve_PEi386     ( ObjectCode* oc );
 118 #elif defined(OBJFORMAT_MACHO)
 119 static int ocVerifyImage_MachO    ( ObjectCode* oc );
 120 static int ocGetNames_MachO       ( ObjectCode* oc );
 121 static int ocResolve_MachO        ( ObjectCode* oc );
 122
 123 static int machoGetMisalignment( FILE * );
 124 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
 125 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
 126 #endif
 127 #ifdef powerpc_HOST_ARCH
 128 static void machoInitSymbolsWithoutUnderscore( void );
 129 #endif
 130 #endif
 131
 132 /* on x86_64 we have a problem with relocating symbol references in
 133  * code that was compiled without -fPIC.  By default, the small memory
 134  * model is used, which assumes that symbol references can fit in a
 135  * 32-bit slot.  The system dynamic linker makes this work for
 136  * references to shared libraries by either (a) allocating a jump
 137  * table slot for code references, or (b) moving the symbol at load
 138  * time (and copying its contents, if necessary) for data references.
 139  *
 140  * We unfortunately can't tell whether symbol references are to code
 141  * or data.  So for now we assume they are code (the vast majority
 142  * are), and allocate jump-table slots.  Unfortunately this will
 143  * SILENTLY generate crashing code for data references.  This hack is
 144  * enabled by X86_64_ELF_NONPIC_HACK.
 145  *
 146  * One workaround is to use shared Haskell libraries.  This is
 147  * coming.  Another workaround is to keep the static libraries but
 148  * compile them with -fPIC, because that will generate PIC references
 149  * to data which can be relocated.  The PIC code is still too green to
 150  * do this systematically, though.
 151  *
 152  * See bug #781
 153  * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
 154  *
 155  * Naming Scheme for Symbol Macros
 156  *
 157  * SymI_*: symbol is internal to the RTS. It resides in an object
 158  *         file/library that is statically.
 159  * SymE_*: symbol is external to the RTS library. It might be linked
 160  *         dynamically.
 161  *
 162  * Sym*_HasProto  : the symbol prototype is imported in an include file
 163  *                  or defined explicitly
 164  * Sym*_NeedsProto: the symbol is undefined and we add a dummy
 165  *                  default proto extern void sym(void);
 166  */
 167 #define X86_64_ELF_NONPIC_HACK 1
 168
 169 /* -----------------------------------------------------------------------------
 170  * Built-in symbols from the RTS
 171  */
 172
 173 typedef struct _RtsSymbolVal {
 174     char   *lbl;
 175     void   *addr;
 176 } RtsSymbolVal;
 177
 178 #if !defined(PAR)
 179 #define Maybe_Stable_Names      SymI_HasProto(mkWeakzh_fast)                    \
 180                                 SymI_HasProto(makeStableNamezh_fast)            \
 181                                 SymI_HasProto(finalizzeWeakzh_fast)
 182 #else
 183 /* These are not available in GUM!!! -- HWL */
 184 #define Maybe_Stable_Names
 185 #endif
 186
 187 #if !defined (mingw32_HOST_OS)
 188 #define RTS_POSIX_ONLY_SYMBOLS                  \
 189       SymI_HasProto(shutdownHaskellAndSignal)   \
 190       SymI_NeedsProto(lockFile)                 \
 191       SymI_NeedsProto(unlockFile)               \
 192       SymI_HasProto(signal_handlers)            \
 193       SymI_HasProto(stg_sig_install)            \
 194       SymI_NeedsProto(nocldstop)
 195 #endif
 196
 197 #if defined (cygwin32_HOST_OS)
 198 #define RTS_MINGW_ONLY_SYMBOLS /**/
 199 /* Don't have the ability to read import libs / archives, so
 200  * we have to stupidly list a lot of what libcygwin.a
 201  * exports; sigh.
 202  */
 203 #define RTS_CYGWIN_ONLY_SYMBOLS                          \
 204       SymI_HasProto(regfree)                             \
 205       SymI_HasProto(regexec)                             \
 206       SymI_HasProto(regerror)                            \
 207       SymI_HasProto(regcomp)                             \
 208       SymI_HasProto(__errno)                             \
 209       SymI_HasProto(access)                              \
 210       SymI_HasProto(chmod)                               \
 211       SymI_HasProto(chdir)                               \
 212       SymI_HasProto(close)                               \
 213       SymI_HasProto(creat)                               \
 214       SymI_HasProto(dup)                                 \
 215       SymI_HasProto(dup2)                                \
 216       SymI_HasProto(fstat)                               \
 217       SymI_HasProto(fcntl)                               \
 218       SymI_HasProto(getcwd)                              \
 219       SymI_HasProto(getenv)                              \
 220       SymI_HasProto(lseek)                               \
 221       SymI_HasProto(open)                                \
 222       SymI_HasProto(fpathconf)                           \
 223       SymI_HasProto(pathconf)                            \
 224       SymI_HasProto(stat)                                \
 225       SymI_HasProto(pow)                                 \
 226       SymI_HasProto(tanh)                                \
 227       SymI_HasProto(cosh)                                \
 228       SymI_HasProto(sinh)                                \
 229       SymI_HasProto(atan)                                \
 230       SymI_HasProto(acos)                                \
 231       SymI_HasProto(asin)                                \
 232       SymI_HasProto(tan)                                 \
 233       SymI_HasProto(cos)                                 \
 234       SymI_HasProto(sin)                                 \
 235       SymI_HasProto(exp)                                 \
 236       SymI_HasProto(log)                                 \
 237       SymI_HasProto(sqrt)                                \
 238       SymI_HasProto(localtime_r)                         \
 239       SymI_HasProto(gmtime_r)                            \
 240       SymI_HasProto(mktime)                              \
 241       SymI_NeedsProto(_imp___tzname)                     \
 242       SymI_HasProto(gettimeofday)                        \
 243       SymI_HasProto(timezone)                            \
 244       SymI_HasProto(tcgetattr)                           \
 245       SymI_HasProto(tcsetattr)                           \
 246       SymI_HasProto(memcpy)                              \
 247       SymI_HasProto(memmove)                             \
 248       SymI_HasProto(realloc)                             \
 249       SymI_HasProto(malloc)                              \
 250       SymI_HasProto(free)                                \
 251       SymI_HasProto(fork)                                \
 252       SymI_HasProto(lstat)                               \
 253       SymI_HasProto(isatty)                              \
 254       SymI_HasProto(mkdir)                               \
 255       SymI_HasProto(opendir)                             \
 256       SymI_HasProto(readdir)                             \
 257       SymI_HasProto(rewinddir)                           \
 258       SymI_HasProto(closedir)                            \
 259       SymI_HasProto(link)                                \
 260       SymI_HasProto(mkfifo)                              \
 261       SymI_HasProto(pipe)                                \
 262       SymI_HasProto(read)                                \
 263       SymI_HasProto(rename)                              \
 264       SymI_HasProto(rmdir)                               \
 265       SymI_HasProto(select)                              \
 266       SymI_HasProto(system)                              \
 267       SymI_HasProto(write)                               \
 268       SymI_HasProto(strcmp)                              \
 269       SymI_HasProto(strcpy)                              \
 270       SymI_HasProto(strncpy)                             \
 271       SymI_HasProto(strerror)                            \
 272       SymI_HasProto(sigaddset)                           \
 273       SymI_HasProto(sigemptyset)                         \
 274       SymI_HasProto(sigprocmask)                         \
 275       SymI_HasProto(umask)                               \
 276       SymI_HasProto(uname)                               \
 277       SymI_HasProto(unlink)                              \
 278       SymI_HasProto(utime)                               \
 279       SymI_HasProto(waitpid)
 280
 281 #elif !defined(mingw32_HOST_OS)
 282 #define RTS_MINGW_ONLY_SYMBOLS /**/
 283 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
 284 #else /* defined(mingw32_HOST_OS) */
 285 #define RTS_POSIX_ONLY_SYMBOLS  /**/
 286 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
 287
 288 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
 289 #if __GNUC__>=3
 290 #define RTS_MINGW_EXTRA_SYMS                    \
 291       SymI_NeedsProto(_imp____mb_cur_max)       \
 292       SymI_NeedsProto(_imp___pctype)
 293 #else
 294 #define RTS_MINGW_EXTRA_SYMS
 295 #endif
 296
 297 #if HAVE_GETTIMEOFDAY
 298 #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
 299 #else
 300 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
 301 #endif
 302
 303 /* These are statically linked from the mingw libraries into the ghc
 304    executable, so we have to employ this hack. */
 305 #define RTS_MINGW_ONLY_SYMBOLS                           \
 306       SymI_HasProto(asyncReadzh_fast)                    \
 307       SymI_HasProto(asyncWritezh_fast)                   \
 308       SymI_HasProto(asyncDoProczh_fast)                  \
 309       SymI_HasProto(memset)                              \
 310       SymI_HasProto(inet_ntoa)                           \
 311       SymI_HasProto(inet_addr)                           \
 312       SymI_HasProto(htonl)                               \
 313       SymI_HasProto(recvfrom)                            \
 314       SymI_HasProto(listen)                              \
 315       SymI_HasProto(bind)                                \
 316       SymI_HasProto(shutdown)                            \
 317       SymI_HasProto(connect)                             \
 318       SymI_HasProto(htons)                               \
 319       SymI_HasProto(ntohs)                               \
 320       SymI_HasProto(getservbyname)                       \
 321       SymI_HasProto(getservbyport)                       \
 322       SymI_HasProto(getprotobynumber)                    \
 323       SymI_HasProto(getprotobyname)                      \
 324       SymI_HasProto(gethostbyname)                       \
 325       SymI_HasProto(gethostbyaddr)                       \
 326       SymI_HasProto(gethostname)                         \
 327       SymI_HasProto(strcpy)                              \
 328       SymI_HasProto(strncpy)                             \
 329       SymI_HasProto(abort)                               \
 330       SymI_NeedsProto(_alloca)                           \
 331       SymI_NeedsProto(isxdigit)                          \
 332       SymI_NeedsProto(isupper)                           \
 333       SymI_NeedsProto(ispunct)                           \
 334       SymI_NeedsProto(islower)                           \
 335       SymI_NeedsProto(isspace)                           \
 336       SymI_NeedsProto(isprint)                           \
 337       SymI_NeedsProto(isdigit)                           \
 338       SymI_NeedsProto(iscntrl)                           \
 339       SymI_NeedsProto(isalpha)                           \
 340       SymI_NeedsProto(isalnum)                           \
 341       SymI_HasProto(strcmp)                              \
 342       SymI_HasProto(memmove)                             \
 343       SymI_HasProto(realloc)                             \
 344       SymI_HasProto(malloc)                              \
 345       SymI_HasProto(pow)                                 \
 346       SymI_HasProto(tanh)                                \
 347       SymI_HasProto(cosh)                                \
 348       SymI_HasProto(sinh)                                \
 349       SymI_HasProto(atan)                                \
 350       SymI_HasProto(acos)                                \
 351       SymI_HasProto(asin)                                \
 352       SymI_HasProto(tan)                                 \
 353       SymI_HasProto(cos)                                 \
 354       SymI_HasProto(sin)                                 \
 355       SymI_HasProto(exp)                                 \
 356       SymI_HasProto(log)                                 \
 357       SymI_HasProto(sqrt)                                \
 358       SymI_HasProto(powf)                                \
 359       SymI_HasProto(tanhf)                               \
 360       SymI_HasProto(coshf)                               \
 361       SymI_HasProto(sinhf)                               \
 362       SymI_HasProto(atanf)                               \
 363       SymI_HasProto(acosf)                               \
 364       SymI_HasProto(asinf)                               \
 365       SymI_HasProto(tanf)                                \
 366       SymI_HasProto(cosf)                                \
 367       SymI_HasProto(sinf)                                \
 368       SymI_HasProto(expf)                                \
 369       SymI_HasProto(logf)                                \
 370       SymI_HasProto(sqrtf)                               \
 371       SymI_HasProto(memcpy)                              \
 372       SymI_HasProto(rts_InstallConsoleEvent)             \
 373       SymI_HasProto(rts_ConsoleHandlerDone)              \
 374       SymI_NeedsProto(mktime)                            \
 375       SymI_NeedsProto(_imp___timezone)                   \
 376       SymI_NeedsProto(_imp___tzname)                     \
 377       SymI_NeedsProto(_imp__tzname)                      \
 378       SymI_NeedsProto(_imp___iob)                        \
 379       SymI_NeedsProto(_imp___osver)                      \
 380       SymI_NeedsProto(localtime)                         \
 381       SymI_NeedsProto(gmtime)                            \
 382       SymI_NeedsProto(opendir)                           \
 383       SymI_NeedsProto(readdir)                           \
 384       SymI_NeedsProto(rewinddir)                         \
 385       RTS_MINGW_EXTRA_SYMS                               \
 386       RTS_MINGW_GETTIMEOFDAY_SYM                         \
 387       SymI_NeedsProto(closedir)
 388 #endif
 389
 390 #if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
 391 #define RTS_DARWIN_ONLY_SYMBOLS                             \
 392      SymI_NeedsProto(asprintf$LDBLStub)                     \
 393      SymI_NeedsProto(err$LDBLStub)                          \
 394      SymI_NeedsProto(errc$LDBLStub)                         \
 395      SymI_NeedsProto(errx$LDBLStub)                         \
 396      SymI_NeedsProto(fprintf$LDBLStub)                      \
 397      SymI_NeedsProto(fscanf$LDBLStub)                       \
 398      SymI_NeedsProto(fwprintf$LDBLStub)                     \
 399      SymI_NeedsProto(fwscanf$LDBLStub)                      \
 400      SymI_NeedsProto(printf$LDBLStub)                       \
 401      SymI_NeedsProto(scanf$LDBLStub)                        \
 402      SymI_NeedsProto(snprintf$LDBLStub)                     \
 403      SymI_NeedsProto(sprintf$LDBLStub)                      \
 404      SymI_NeedsProto(sscanf$LDBLStub)                       \
 405      SymI_NeedsProto(strtold$LDBLStub)                      \
 406      SymI_NeedsProto(swprintf$LDBLStub)                     \
 407      SymI_NeedsProto(swscanf$LDBLStub)                      \
 408      SymI_NeedsProto(syslog$LDBLStub)                       \
 409      SymI_NeedsProto(vasprintf$LDBLStub)                    \
 410      SymI_NeedsProto(verr$LDBLStub)                         \
 411      SymI_NeedsProto(verrc$LDBLStub)                        \
 412      SymI_NeedsProto(verrx$LDBLStub)                        \
 413      SymI_NeedsProto(vfprintf$LDBLStub)                     \
 414      SymI_NeedsProto(vfscanf$LDBLStub)                      \
 415      SymI_NeedsProto(vfwprintf$LDBLStub)                    \
 416      SymI_NeedsProto(vfwscanf$LDBLStub)                     \
 417      SymI_NeedsProto(vprintf$LDBLStub)                      \
 418      SymI_NeedsProto(vscanf$LDBLStub)                       \
 419      SymI_NeedsProto(vsnprintf$LDBLStub)                    \
 420      SymI_NeedsProto(vsprintf$LDBLStub)                     \
 421      SymI_NeedsProto(vsscanf$LDBLStub)                      \
 422      SymI_NeedsProto(vswprintf$LDBLStub)                    \
 423      SymI_NeedsProto(vswscanf$LDBLStub)                     \
 424      SymI_NeedsProto(vsyslog$LDBLStub)                      \
 425      SymI_NeedsProto(vwarn$LDBLStub)                        \
 426      SymI_NeedsProto(vwarnc$LDBLStub)                       \
 427      SymI_NeedsProto(vwarnx$LDBLStub)                       \
 428      SymI_NeedsProto(vwprintf$LDBLStub)                     \
 429      SymI_NeedsProto(vwscanf$LDBLStub)                      \
 430      SymI_NeedsProto(warn$LDBLStub)                         \
 431      SymI_NeedsProto(warnc$LDBLStub)                        \
 432      SymI_NeedsProto(warnx$LDBLStub)                        \
 433      SymI_NeedsProto(wcstold$LDBLStub)                      \
 434      SymI_NeedsProto(wprintf$LDBLStub)                      \
 435      SymI_NeedsProto(wscanf$LDBLStub)
 436 #else
 437 #define RTS_DARWIN_ONLY_SYMBOLS
 438 #endif
 439
 440 #ifndef SMP
 441 # define MAIN_CAP_SYM SymI_HasProto(MainCapability)
 442 #else
 443 # define MAIN_CAP_SYM
 444 #endif
 445
 446 #if !defined(mingw32_HOST_OS)
 447 #define RTS_USER_SIGNALS_SYMBOLS \
 448    SymI_HasProto(setIOManagerPipe)
 449 #else
 450 #define RTS_USER_SIGNALS_SYMBOLS     \
 451    SymI_HasProto(sendIOManagerEvent) \
 452    SymI_HasProto(readIOManagerEvent) \
 453    SymI_HasProto(getIOManagerEvent)  \
 454    SymI_HasProto(console_handler)
 455 #endif
 456
 457 #define RTS_LIBFFI_SYMBOLS                                  \
 458      SymE_NeedsProto(ffi_prep_cif)                          \
 459      SymE_NeedsProto(ffi_call)                              \
 460      SymE_NeedsProto(ffi_type_void)                         \
 461      SymE_NeedsProto(ffi_type_float)                        \
 462      SymE_NeedsProto(ffi_type_double)                       \
 463      SymE_NeedsProto(ffi_type_sint64)                       \
 464      SymE_NeedsProto(ffi_type_uint64)                       \
 465      SymE_NeedsProto(ffi_type_sint32)                       \
 466      SymE_NeedsProto(ffi_type_uint32)                       \
 467      SymE_NeedsProto(ffi_type_sint16)                       \
 468      SymE_NeedsProto(ffi_type_uint16)                       \
 469      SymE_NeedsProto(ffi_type_sint8)                        \
 470      SymE_NeedsProto(ffi_type_uint8)                        \
 471      SymE_NeedsProto(ffi_type_pointer)
 472
 473 #ifdef TABLES_NEXT_TO_CODE
 474 #define RTS_RET_SYMBOLS /* nothing */
 475 #else
 476 #define RTS_RET_SYMBOLS                                 \
 477       SymI_HasProto(stg_enter_ret)                      \
 478       SymI_HasProto(stg_gc_fun_ret)                     \
 479       SymI_HasProto(stg_ap_v_ret)                       \
 480       SymI_HasProto(stg_ap_f_ret)                       \
 481       SymI_HasProto(stg_ap_d_ret)                       \
 482       SymI_HasProto(stg_ap_l_ret)                       \
 483       SymI_HasProto(stg_ap_n_ret)                       \
 484       SymI_HasProto(stg_ap_p_ret)                       \
 485       SymI_HasProto(stg_ap_pv_ret)                      \
 486       SymI_HasProto(stg_ap_pp_ret)                      \
 487       SymI_HasProto(stg_ap_ppv_ret)                     \
 488       SymI_HasProto(stg_ap_ppp_ret)                     \
 489       SymI_HasProto(stg_ap_pppv_ret)                    \
 490       SymI_HasProto(stg_ap_pppp_ret)                    \
 491       SymI_HasProto(stg_ap_ppppp_ret)                   \
 492       SymI_HasProto(stg_ap_pppppp_ret)
 493 #endif
 494
 495 /* On Windows, we link libgmp.a statically into libHSrts.dll */
 496 #ifdef mingw32_HOST_OS
 497 #define GMP_SYMS                                        \
 498       SymI_HasProto(__gmpz_cmp)                         \
 499       SymI_HasProto(__gmpz_cmp_si)                      \
 500       SymI_HasProto(__gmpz_cmp_ui)                      \
 501       SymI_HasProto(__gmpz_get_si)                      \
 502       SymI_HasProto(__gmpz_get_ui)
 503 #else
 504 #define GMP_SYMS                                        \
 505       SymE_HasProto(__gmpz_cmp)                         \
 506       SymE_HasProto(__gmpz_cmp_si)                      \
 507       SymE_HasProto(__gmpz_cmp_ui)                      \
 508       SymE_HasProto(__gmpz_get_si)                      \
 509       SymE_HasProto(__gmpz_get_ui)
 510 #endif
 511
 512 #define RTS_SYMBOLS                                     \
 513       Maybe_Stable_Names                                \
 514       SymI_HasProto(StgReturn)                          \
 515       SymI_HasProto(stg_enter_info)                     \
 516       SymI_HasProto(stg_gc_void_info)                   \
 517       SymI_HasProto(__stg_gc_enter_1)                   \
 518       SymI_HasProto(stg_gc_noregs)                      \
 519       SymI_HasProto(stg_gc_unpt_r1_info)                \
 520       SymI_HasProto(stg_gc_unpt_r1)                     \
 521       SymI_HasProto(stg_gc_unbx_r1_info)                \
 522       SymI_HasProto(stg_gc_unbx_r1)                     \
 523       SymI_HasProto(stg_gc_f1_info)                     \
 524       SymI_HasProto(stg_gc_f1)                          \
 525       SymI_HasProto(stg_gc_d1_info)                     \
 526       SymI_HasProto(stg_gc_d1)                          \
 527       SymI_HasProto(stg_gc_l1_info)                     \
 528       SymI_HasProto(stg_gc_l1)                          \
 529       SymI_HasProto(__stg_gc_fun)                       \
 530       SymI_HasProto(stg_gc_fun_info)                    \
 531       SymI_HasProto(stg_gc_gen)                         \
 532       SymI_HasProto(stg_gc_gen_info)                    \
 533       SymI_HasProto(stg_gc_gen_hp)                      \
 534       SymI_HasProto(stg_gc_ut)                          \
 535       SymI_HasProto(stg_gen_yield)                      \
 536       SymI_HasProto(stg_yield_noregs)                   \
 537       SymI_HasProto(stg_yield_to_interpreter)           \
 538       SymI_HasProto(stg_gen_block)                      \
 539       SymI_HasProto(stg_block_noregs)                   \
 540       SymI_HasProto(stg_block_1)                        \
 541       SymI_HasProto(stg_block_takemvar)                 \
 542       SymI_HasProto(stg_block_putmvar)                  \
 543       MAIN_CAP_SYM                                      \
 544       SymI_HasProto(MallocFailHook)                     \
 545       SymI_HasProto(OnExitHook)                         \
 546       SymI_HasProto(OutOfHeapHook)                      \
 547       SymI_HasProto(StackOverflowHook)                  \
 548       SymI_HasProto(__encodeDouble)                     \
 549       SymI_HasProto(__encodeFloat)                      \
 550       SymI_HasProto(addDLL)                             \
 551       GMP_SYMS                                          \
 552       SymI_HasProto(__int_encodeDouble)                 \
 553       SymI_HasProto(__word_encodeDouble)                \
 554       SymI_HasProto(__2Int_encodeDouble)                \
 555       SymI_HasProto(__int_encodeFloat)                  \
 556       SymI_HasProto(__word_encodeFloat)                 \
 557       SymI_HasProto(andIntegerzh_fast)                  \
 558       SymI_HasProto(atomicallyzh_fast)                  \
 559       SymI_HasProto(barf)                               \
 560       SymI_HasProto(debugBelch)                         \
 561       SymI_HasProto(errorBelch)                         \
 562       SymI_HasProto(asyncExceptionsBlockedzh_fast)      \
 563       SymI_HasProto(blockAsyncExceptionszh_fast)        \
 564       SymI_HasProto(catchzh_fast)                       \
 565       SymI_HasProto(catchRetryzh_fast)                  \
 566       SymI_HasProto(catchSTMzh_fast)                    \
 567       SymI_HasProto(checkzh_fast)                       \
 568       SymI_HasProto(closure_flags)                      \
 569       SymI_HasProto(cmp_thread)                         \
 570       SymI_HasProto(cmpIntegerzh_fast)                  \
 571       SymI_HasProto(cmpIntegerIntzh_fast)               \
 572       SymI_HasProto(complementIntegerzh_fast)           \
 573       SymI_HasProto(createAdjustor)                     \
 574       SymI_HasProto(decodeDoublezh_fast)                \
 575       SymI_HasProto(decodeFloatzh_fast)                 \
 576       SymI_HasProto(decodeDoublezu2Intzh_fast)          \
 577       SymI_HasProto(decodeFloatzuIntzh_fast)            \
 578       SymI_HasProto(defaultsHook)                       \
 579       SymI_HasProto(delayzh_fast)                       \
 580       SymI_HasProto(deRefWeakzh_fast)                   \
 581       SymI_HasProto(deRefStablePtrzh_fast)              \
 582       SymI_HasProto(dirty_MUT_VAR)                      \
 583       SymI_HasProto(divExactIntegerzh_fast)             \
 584       SymI_HasProto(divModIntegerzh_fast)               \
 585       SymI_HasProto(forkzh_fast)                        \
 586       SymI_HasProto(forkOnzh_fast)                      \
 587       SymI_HasProto(forkProcess)                        \
 588       SymI_HasProto(forkOS_createThread)                \
 589       SymI_HasProto(freeHaskellFunctionPtr)             \
 590       SymI_HasProto(freeStablePtr)                      \
 591       SymI_HasProto(getOrSetTypeableStore)              \
 592       SymI_HasProto(gcdIntegerzh_fast)                  \
 593       SymI_HasProto(gcdIntegerIntzh_fast)               \
 594       SymI_HasProto(gcdIntzh_fast)                      \
 595       SymI_HasProto(genSymZh)                           \
 596       SymI_HasProto(genericRaise)                       \
 597       SymI_HasProto(getProgArgv)                        \
 598       SymI_HasProto(getFullProgArgv)                    \
 599       SymI_HasProto(getStablePtr)                       \
 600       SymI_HasProto(hs_init)                            \
 601       SymI_HasProto(hs_exit)                            \
 602       SymI_HasProto(hs_set_argv)                        \
 603       SymI_HasProto(hs_add_root)                        \
 604       SymI_HasProto(hs_perform_gc)                      \
 605       SymI_HasProto(hs_free_stable_ptr)                 \
 606       SymI_HasProto(hs_free_fun_ptr)                    \
 607       SymI_HasProto(hs_hpc_rootModule)                  \
 608       SymI_HasProto(initLinker)                         \
 609       SymI_HasProto(unpackClosurezh_fast)               \
 610       SymI_HasProto(getApStackValzh_fast)               \
 611       SymI_HasProto(int2Integerzh_fast)                 \
 612       SymI_HasProto(integer2Intzh_fast)                 \
 613       SymI_HasProto(integer2Wordzh_fast)                \
 614       SymI_HasProto(isCurrentThreadBoundzh_fast)        \
 615       SymI_HasProto(isDoubleDenormalized)               \
 616       SymI_HasProto(isDoubleInfinite)                   \
 617       SymI_HasProto(isDoubleNaN)                        \
 618       SymI_HasProto(isDoubleNegativeZero)               \
 619       SymI_HasProto(isEmptyMVarzh_fast)                 \
 620       SymI_HasProto(isFloatDenormalized)                \
 621       SymI_HasProto(isFloatInfinite)                    \
 622       SymI_HasProto(isFloatNaN)                         \
 623       SymI_HasProto(isFloatNegativeZero)                \
 624       SymI_HasProto(killThreadzh_fast)                  \
 625       SymI_HasProto(loadObj)                            \
 626       SymI_HasProto(insertStableSymbol)                 \
 627       SymI_HasProto(insertSymbol)                       \
 628       SymI_HasProto(lookupSymbol)                       \
 629       SymI_HasProto(makeStablePtrzh_fast)               \
 630       SymI_HasProto(minusIntegerzh_fast)                \
 631       SymI_HasProto(mkApUpd0zh_fast)                    \
 632       SymI_HasProto(myThreadIdzh_fast)                  \
 633       SymI_HasProto(labelThreadzh_fast)                 \
 634       SymI_HasProto(newArrayzh_fast)                    \
 635       SymI_HasProto(newBCOzh_fast)                      \
 636       SymI_HasProto(newByteArrayzh_fast)                \
 637       SymI_HasProto_redirect(newCAF, newDynCAF)         \
 638       SymI_HasProto(newMVarzh_fast)                     \
 639       SymI_HasProto(newMutVarzh_fast)                   \
 640       SymI_HasProto(newTVarzh_fast)                     \
 641       SymI_HasProto(noDuplicatezh_fast)                 \
 642       SymI_HasProto(atomicModifyMutVarzh_fast)          \
 643       SymI_HasProto(newPinnedByteArrayzh_fast)          \
 644       SymI_HasProto(newSpark)                           \
 645       SymI_HasProto(orIntegerzh_fast)                   \
 646       SymI_HasProto(performGC)                          \
 647       SymI_HasProto(performMajorGC)                     \
 648       SymI_HasProto(plusIntegerzh_fast)                 \
 649       SymI_HasProto(prog_argc)                          \
 650       SymI_HasProto(prog_argv)                          \
 651       SymI_HasProto(putMVarzh_fast)                     \
 652       SymI_HasProto(quotIntegerzh_fast)                 \
 653       SymI_HasProto(quotRemIntegerzh_fast)              \
 654       SymI_HasProto(raisezh_fast)                       \
 655       SymI_HasProto(raiseIOzh_fast)                     \
 656       SymI_HasProto(readTVarzh_fast)                    \
 657       SymI_HasProto(readTVarIOzh_fast)                  \
 658       SymI_HasProto(remIntegerzh_fast)                  \
 659       SymI_HasProto(resetNonBlockingFd)                 \
 660       SymI_HasProto(resumeThread)                       \
 661       SymI_HasProto(resolveObjs)                        \
 662       SymI_HasProto(retryzh_fast)                       \
 663       SymI_HasProto(rts_apply)                          \
 664       SymI_HasProto(rts_checkSchedStatus)               \
 665       SymI_HasProto(rts_eval)                           \
 666       SymI_HasProto(rts_evalIO)                         \
 667       SymI_HasProto(rts_evalLazyIO)                     \
 668       SymI_HasProto(rts_evalStableIO)                   \
 669       SymI_HasProto(rts_eval_)                          \
 670       SymI_HasProto(rts_getBool)                        \
 671       SymI_HasProto(rts_getChar)                        \
 672       SymI_HasProto(rts_getDouble)                      \
 673       SymI_HasProto(rts_getFloat)                       \
 674       SymI_HasProto(rts_getInt)                         \
 675       SymI_HasProto(rts_getInt8)                        \
 676       SymI_HasProto(rts_getInt16)                       \
 677       SymI_HasProto(rts_getInt32)                       \
 678       SymI_HasProto(rts_getInt64)                       \
 679       SymI_HasProto(rts_getPtr)                         \
 680       SymI_HasProto(rts_getFunPtr)                      \
 681       SymI_HasProto(rts_getStablePtr)                   \
 682       SymI_HasProto(rts_getThreadId)                    \
 683       SymI_HasProto(rts_getWord)                        \
 684       SymI_HasProto(rts_getWord8)                       \
 685       SymI_HasProto(rts_getWord16)                      \
 686       SymI_HasProto(rts_getWord32)                      \
 687       SymI_HasProto(rts_getWord64)                      \
 688       SymI_HasProto(rts_lock)                           \
 689       SymI_HasProto(rts_mkBool)                         \
 690       SymI_HasProto(rts_mkChar)                         \
 691       SymI_HasProto(rts_mkDouble)                       \
 692       SymI_HasProto(rts_mkFloat)                        \
 693       SymI_HasProto(rts_mkInt)                          \
 694       SymI_HasProto(rts_mkInt8)                         \
 695       SymI_HasProto(rts_mkInt16)                        \
 696       SymI_HasProto(rts_mkInt32)                        \
 697       SymI_HasProto(rts_mkInt64)                        \
 698       SymI_HasProto(rts_mkPtr)                          \
 699       SymI_HasProto(rts_mkFunPtr)                       \
 700       SymI_HasProto(rts_mkStablePtr)                    \
 701       SymI_HasProto(rts_mkString)                       \
 702       SymI_HasProto(rts_mkWord)                         \
 703       SymI_HasProto(rts_mkWord8)                        \
 704       SymI_HasProto(rts_mkWord16)                       \
 705       SymI_HasProto(rts_mkWord32)                       \
 706       SymI_HasProto(rts_mkWord64)                       \
 707       SymI_HasProto(rts_unlock)                         \
 708       SymI_HasProto(rtsSupportsBoundThreads)            \
 709       SymI_HasProto(__hscore_get_saved_termios)         \
 710       SymI_HasProto(__hscore_set_saved_termios)         \
 711       SymI_HasProto(setProgArgv)                        \
 712       SymI_HasProto(startupHaskell)                     \
 713       SymI_HasProto(shutdownHaskell)                    \
 714       SymI_HasProto(shutdownHaskellAndExit)             \
 715       SymI_HasProto(stable_ptr_table)                   \
 716       SymI_HasProto(stackOverflow)                      \
 717       SymI_HasProto(stg_CAF_BLACKHOLE_info)             \
 718       SymI_HasProto(awakenBlockedQueue)                 \
 719       SymI_HasProto(startTimer)                         \
 720       SymI_HasProto(stg_CHARLIKE_closure)               \
 721       SymI_HasProto(stg_MVAR_CLEAN_info)                \
 722       SymI_HasProto(stg_MVAR_DIRTY_info)                \
 723       SymI_HasProto(stg_IND_STATIC_info)                \
 724       SymI_HasProto(stg_INTLIKE_closure)                \
 725       SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info)        \
 726       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info)       \
 727       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info)      \
 728       SymI_HasProto(stg_WEAK_info)                      \
 729       SymI_HasProto(stg_ap_v_info)                      \
 730       SymI_HasProto(stg_ap_f_info)                      \
 731       SymI_HasProto(stg_ap_d_info)                      \
 732       SymI_HasProto(stg_ap_l_info)                      \
 733       SymI_HasProto(stg_ap_n_info)                      \
 734       SymI_HasProto(stg_ap_p_info)                      \
 735       SymI_HasProto(stg_ap_pv_info)                     \
 736       SymI_HasProto(stg_ap_pp_info)                     \
 737       SymI_HasProto(stg_ap_ppv_info)                    \
 738       SymI_HasProto(stg_ap_ppp_info)                    \
 739       SymI_HasProto(stg_ap_pppv_info)                   \
 740       SymI_HasProto(stg_ap_pppp_info)                   \
 741       SymI_HasProto(stg_ap_ppppp_info)                  \
 742       SymI_HasProto(stg_ap_pppppp_info)                 \
 743       SymI_HasProto(stg_ap_0_fast)                      \
 744       SymI_HasProto(stg_ap_v_fast)                      \
 745       SymI_HasProto(stg_ap_f_fast)                      \
 746       SymI_HasProto(stg_ap_d_fast)                      \
 747       SymI_HasProto(stg_ap_l_fast)                      \
 748       SymI_HasProto(stg_ap_n_fast)                      \
 749       SymI_HasProto(stg_ap_p_fast)                      \
 750       SymI_HasProto(stg_ap_pv_fast)                     \
 751       SymI_HasProto(stg_ap_pp_fast)                     \
 752       SymI_HasProto(stg_ap_ppv_fast)                    \
 753       SymI_HasProto(stg_ap_ppp_fast)                    \
 754       SymI_HasProto(stg_ap_pppv_fast)                   \
 755       SymI_HasProto(stg_ap_pppp_fast)                   \
 756       SymI_HasProto(stg_ap_ppppp_fast)                  \
 757       SymI_HasProto(stg_ap_pppppp_fast)                 \
 758       SymI_HasProto(stg_ap_1_upd_info)                  \
 759       SymI_HasProto(stg_ap_2_upd_info)                  \
 760       SymI_HasProto(stg_ap_3_upd_info)                  \
 761       SymI_HasProto(stg_ap_4_upd_info)                  \
 762       SymI_HasProto(stg_ap_5_upd_info)                  \
 763       SymI_HasProto(stg_ap_6_upd_info)                  \
 764       SymI_HasProto(stg_ap_7_upd_info)                  \
 765       SymI_HasProto(stg_exit)                           \
 766       SymI_HasProto(stg_sel_0_upd_info)                 \
 767       SymI_HasProto(stg_sel_10_upd_info)                \
 768       SymI_HasProto(stg_sel_11_upd_info)                \
 769       SymI_HasProto(stg_sel_12_upd_info)                \
 770       SymI_HasProto(stg_sel_13_upd_info)                \
 771       SymI_HasProto(stg_sel_14_upd_info)                \
 772       SymI_HasProto(stg_sel_15_upd_info)                \
 773       SymI_HasProto(stg_sel_1_upd_info)                 \
 774       SymI_HasProto(stg_sel_2_upd_info)                 \
 775       SymI_HasProto(stg_sel_3_upd_info)                 \
 776       SymI_HasProto(stg_sel_4_upd_info)                 \
 777       SymI_HasProto(stg_sel_5_upd_info)                 \
 778       SymI_HasProto(stg_sel_6_upd_info)                 \
 779       SymI_HasProto(stg_sel_7_upd_info)                 \
 780       SymI_HasProto(stg_sel_8_upd_info)                 \
 781       SymI_HasProto(stg_sel_9_upd_info)                 \
 782       SymI_HasProto(stg_upd_frame_info)                 \
 783       SymI_HasProto(suspendThread)                      \
 784       SymI_HasProto(takeMVarzh_fast)                    \
 785       SymI_HasProto(threadStatuszh_fast)                \
 786       SymI_HasProto(timesIntegerzh_fast)                \
 787       SymI_HasProto(tryPutMVarzh_fast)                  \
 788       SymI_HasProto(tryTakeMVarzh_fast)                 \
 789       SymI_HasProto(unblockAsyncExceptionszh_fast)      \
 790       SymI_HasProto(unloadObj)                          \
 791       SymI_HasProto(unsafeThawArrayzh_fast)             \
 792       SymI_HasProto(waitReadzh_fast)                    \
 793       SymI_HasProto(waitWritezh_fast)                   \
 794       SymI_HasProto(word2Integerzh_fast)                \
 795       SymI_HasProto(writeTVarzh_fast)                   \
 796       SymI_HasProto(xorIntegerzh_fast)                  \
 797       SymI_HasProto(yieldzh_fast)                       \
 798       SymI_NeedsProto(stg_interp_constr_entry)          \
 799       SymI_HasProto(allocateExec)                       \
 800       SymI_HasProto(freeExec)                           \
 801       SymI_HasProto(getAllocations)                     \
 802       SymI_HasProto(revertCAFs)                         \
 803       SymI_HasProto(RtsFlags)                           \
 804       SymI_NeedsProto(rts_breakpoint_io_action)         \
 805       SymI_NeedsProto(rts_stop_next_breakpoint)         \
 806       SymI_NeedsProto(rts_stop_on_exception)            \
 807       SymI_HasProto(stopTimer)                          \
 808       SymI_HasProto(n_capabilities)                     \
 809       RTS_USER_SIGNALS_SYMBOLS
 810
 811 #ifdef SUPPORT_LONG_LONGS
 812 #define RTS_LONG_LONG_SYMS                              \
 813       SymI_HasProto(int64ToIntegerzh_fast)              \
 814       SymI_HasProto(word64ToIntegerzh_fast)
 815 #else
 816 #define RTS_LONG_LONG_SYMS /* nothing */
 817 #endif
 818
 819 // 64-bit support functions in libgcc.a
 820 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
 821 #define RTS_LIBGCC_SYMBOLS                             \
 822       SymI_NeedsProto(__divdi3)                        \
 823       SymI_NeedsProto(__udivdi3)                       \
 824       SymI_NeedsProto(__moddi3)                        \
 825       SymI_NeedsProto(__umoddi3)                       \
 826       SymI_NeedsProto(__muldi3)                        \
 827       SymI_NeedsProto(__ashldi3)                       \
 828       SymI_NeedsProto(__ashrdi3)                       \
 829       SymI_NeedsProto(__lshrdi3)                       \
 830       SymI_NeedsProto(__eprintf)
 831 #elif defined(ia64_HOST_ARCH)
 832 #define RTS_LIBGCC_SYMBOLS                              \
 833       SymI_NeedsProto(__divdi3)                         \
 834       SymI_NeedsProto(__udivdi3)                        \
 835       SymI_NeedsProto(__moddi3)                         \
 836       SymI_NeedsProto(__umoddi3)                        \
 837       SymI_NeedsProto(__divsf3)                         \
 838       SymI_NeedsProto(__divdf3)
 839 #else
 840 #define RTS_LIBGCC_SYMBOLS
 841 #endif
 842
 843 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
 844       // Symbols that don't have a leading underscore
 845       // on Mac OS X. They have to receive special treatment,
 846       // see machoInitSymbolsWithoutUnderscore()
 847 #define RTS_MACHO_NOUNDERLINE_SYMBOLS           \
 848       SymI_NeedsProto(saveFP)                           \
 849       SymI_NeedsProto(restFP)
 850 #endif
 851
 852 /* entirely bogus claims about types of these symbols */
 853 #define SymI_NeedsProto(vvv)  extern void vvv(void);
 854 #if defined(__PIC__) && defined(mingw32_TARGET_OS)
 855 #define SymE_HasProto(vvv)    SymE_HasProto(vvv);
 856 #define SymE_NeedsProto(vvv)    extern void _imp__ ## vvv (void);
 857 #else
 858 #define SymE_NeedsProto(vvv)  SymI_NeedsProto(vvv);
 859 #define SymE_HasProto(vvv)    SymI_HasProto(vvv)
 860 #endif
 861 #define SymI_HasProto(vvv) /**/
 862 #define SymI_HasProto_redirect(vvv,xxx) /**/
 863 RTS_SYMBOLS
 864 RTS_RET_SYMBOLS
 865 RTS_LONG_LONG_SYMS
 866 RTS_POSIX_ONLY_SYMBOLS
 867 RTS_MINGW_ONLY_SYMBOLS
 868 RTS_CYGWIN_ONLY_SYMBOLS
 869 RTS_DARWIN_ONLY_SYMBOLS
 870 RTS_LIBGCC_SYMBOLS
 871 RTS_LIBFFI_SYMBOLS
 872 #undef SymI_NeedsProto
 873 #undef SymI_HasProto
 874 #undef SymI_HasProto_redirect
 875 #undef SymE_HasProto
 876 #undef SymE_NeedsProto
 877
 878 #ifdef LEADING_UNDERSCORE
 879 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
 880 #else
 881 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
 882 #endif
 883
 884 #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
 885                     (void*)(&(vvv)) },
 886 #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
 887             (void*)DLL_IMPORT_DATA_REF(vvv) },
 888
 889 #define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
 890 #define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
 891
 892 // SymI_HasProto_redirect allows us to redirect references to one symbol to
 893 // another symbol.  See newCAF/newDynCAF for an example.
 894 #define SymI_HasProto_redirect(vvv,xxx) \
 895     { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
 896       (void*)(&(xxx)) },
 897
 898 static RtsSymbolVal rtsSyms[] = {
 899       RTS_SYMBOLS
 900       RTS_RET_SYMBOLS
 901       RTS_LONG_LONG_SYMS
 902       RTS_POSIX_ONLY_SYMBOLS
 903       RTS_MINGW_ONLY_SYMBOLS
 904       RTS_CYGWIN_ONLY_SYMBOLS
 905       RTS_DARWIN_ONLY_SYMBOLS
 906       RTS_LIBGCC_SYMBOLS
 907       RTS_LIBFFI_SYMBOLS
 908 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
 909       // dyld stub code contains references to this,
 910       // but it should never be called because we treat
 911       // lazy pointers as nonlazy.
 912       { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
 913 #endif
 914       { 0, 0 } /* sentinel */
 915 };
 916
 917
 918
 919 /* -----------------------------------------------------------------------------
 920  * Insert symbols into hash tables, checking for duplicates.
 921  */
 922
 923 static void ghciInsertStrHashTable ( char* obj_name,
 924                                      HashTable *table,
 925                                      char* key,
 926                                      void *data
 927                                    )
 928 {
 929    if (lookupHashTable(table, (StgWord)key) == NULL)
 930    {
 931       insertStrHashTable(table, (StgWord)key, data);
 932       return;
 933    }
 934    debugBelch(
 935       "\n\n"
 936       "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
 937       "   %s\n"
 938       "whilst processing object file\n"
 939       "   %s\n"
 940       "This could be caused by:\n"
 941       "   * Loading two different object files which export the same symbol\n"
 942       "   * Specifying the same object file twice on the GHCi command line\n"
 943       "   * An incorrect `package.conf' entry, causing some object to be\n"
 944       "     loaded twice.\n"
 945       "GHCi cannot safely continue in this situation.  Exiting now.  Sorry.\n"
 946       "\n",
 947       (char*)key,
 948       obj_name
 949    );
 950    exit(1);
 951 }
 952 /* -----------------------------------------------------------------------------
 953  * initialize the object linker
 954  */
 955
 956
 957 static int linker_init_done = 0 ;
 958
 959 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 960 static void *dl_prog_handle;
 961 #endif
 962
 963 void
 964 initLinker( void )
 965 {
 966     RtsSymbolVal *sym;
 967
 968     /* Make initLinker idempotent, so we can call it
 969        before evey relevant operation; that means we
 970        don't need to initialise the linker separately */
 971     if (linker_init_done == 1) { return; } else {
 972       linker_init_done = 1;
 973     }
 974
 975     stablehash = allocStrHashTable();
 976     symhash = allocStrHashTable();
 977
 978     /* populate the symbol table with stuff from the RTS */
 979     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
 980         ghciInsertStrHashTable("(GHCi built-in symbols)",
 981                                symhash, sym->lbl, sym->addr);
 982     }
 983 #   if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
 984     machoInitSymbolsWithoutUnderscore();
 985 #   endif
 986
 987 #   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
 988 #   if defined(RTLD_DEFAULT)
 989     dl_prog_handle = RTLD_DEFAULT;
 990 #   else
 991     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 992 #   endif /* RTLD_DEFAULT */
 993 #   endif
 994 }
 995
 996 /* -----------------------------------------------------------------------------
 997  *                  Loading DLL or .so dynamic libraries
 998  * -----------------------------------------------------------------------------
 999  *
1000  * Add a DLL from which symbols may be found.  In the ELF case, just
1001  * do RTLD_GLOBAL-style add, so no further messing around needs to
1002  * happen in order that symbols in the loaded .so are findable --
1003  * lookupSymbol() will subsequently see them by dlsym on the program's
1004  * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
1005  *
1006  * In the PEi386 case, open the DLLs and put handles to them in a
1007  * linked list.  When looking for a symbol, try all handles in the
1008  * list.  This means that we need to load even DLLs that are guaranteed
1009  * to be in the ghc.exe image already, just so we can get a handle
1010  * to give to loadSymbol, so that we can find the symbols.  For such
1011  * libraries, the LoadLibrary call should be a no-op except for returning
1012  * the handle.
1013  *
1014  */
1015
1016 #if defined(OBJFORMAT_PEi386)
1017 /* A record for storing handles into DLLs. */
1018
1019 typedef
1020    struct _OpenedDLL {
1021       char*              name;
1022       struct _OpenedDLL* next;
1023       HINSTANCE instance;
1024    }
1025    OpenedDLL;
1026
1027 /* A list thereof. */
1028 static OpenedDLL* opened_dlls = NULL;
1029 #endif
1030
1031 const char *
1032 addDLL( char *dll_name )
1033 {
1034 #  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1035    /* ------------------- ELF DLL loader ------------------- */
1036    void *hdl;
1037    const char *errmsg;
1038
1039    initLinker();
1040
1041    // omitted: RTLD_NOW
1042    // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1043    hdl= dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
1044
1045    if (hdl == NULL) {
1046       /* dlopen failed; return a ptr to the error msg. */
1047       errmsg = dlerror();
1048       if (errmsg == NULL) errmsg = "addDLL: unknown error";
1049       return errmsg;
1050    } else {
1051       return NULL;
1052    }
1053    /*NOTREACHED*/
1054
1055 #  elif defined(OBJFORMAT_PEi386)
1056    /* ------------------- Win32 DLL loader ------------------- */
1057
1058    char*      buf;
1059    OpenedDLL* o_dll;
1060    HINSTANCE  instance;
1061
1062    initLinker();
1063
1064    /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1065
1066    /* See if we've already got it, and ignore if so. */
1067    for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1068       if (0 == strcmp(o_dll->name, dll_name))
1069          return NULL;
1070    }
1071
1072    /* The file name has no suffix (yet) so that we can try
1073       both foo.dll and foo.drv
1074
1075       The documentation for LoadLibrary says:
1076         If no file name extension is specified in the lpFileName
1077         parameter, the default library extension .dll is
1078         appended. However, the file name string can include a trailing
1079         point character (.) to indicate that the module name has no
1080         extension. */
1081
1082    buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1083    sprintf(buf, "%s.DLL", dll_name);
1084    instance = LoadLibrary(buf);
1085    if (instance == NULL) {
1086        if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1087        // KAA: allow loading of drivers (like winspool.drv)
1088        sprintf(buf, "%s.DRV", dll_name);
1089        instance = LoadLibrary(buf);
1090        if (instance == NULL) {
1091            if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1092            // #1883: allow loading of unix-style libfoo.dll DLLs
1093            sprintf(buf, "lib%s.DLL", dll_name);
1094            instance = LoadLibrary(buf);
1095            if (instance == NULL) {
1096                goto error;
1097            }
1098        }
1099    }
1100    stgFree(buf);
1101
1102    /* Add this DLL to the list of DLLs in which to search for symbols. */
1103    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1104    o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
1105    strcpy(o_dll->name, dll_name);
1106    o_dll->instance = instance;
1107    o_dll->next     = opened_dlls;
1108    opened_dlls     = o_dll;
1109
1110    return NULL;
1111
1112 error:
1113    stgFree(buf);
1114    sysErrorBelch(dll_name);
1115
1116    /* LoadLibrary failed; return a ptr to the error msg. */
1117    return "addDLL: could not load DLL";
1118
1119 #  else
1120    barf("addDLL: not implemented on this platform");
1121 #  endif
1122 }
1123
1124 /* -----------------------------------------------------------------------------
1125  * insert a stable symbol in the hash table
1126  */
1127
1128 void
1129 insertStableSymbol(char* obj_name, char* key, StgPtr p)
1130 {
1131   ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1132 }
1133
1134
1135 /* -----------------------------------------------------------------------------
1136  * insert a symbol in the hash table
1137  */
1138 void
1139 insertSymbol(char* obj_name, char* key, void* data)
1140 {
1141   ghciInsertStrHashTable(obj_name, symhash, key, data);
1142 }
1143
1144 /* -----------------------------------------------------------------------------
1145  * lookup a symbol in the hash table
1146  */
1147 void *
1148 lookupSymbol( char *lbl )
1149 {
1150     void *val;
1151     initLinker() ;
1152     ASSERT(symhash != NULL);
1153     val = lookupStrHashTable(symhash, lbl);
1154
1155     if (val == NULL) {
1156 #       if defined(OBJFORMAT_ELF)
1157         return dlsym(dl_prog_handle, lbl);
1158 #       elif defined(OBJFORMAT_MACHO)
1159 #       if HAVE_DLFCN_H
1160         /* On OS X 10.3 and later, we use dlsym instead of the old legacy
1161            interface.
1162
1163            HACK: On OS X, global symbols are prefixed with an underscore.
1164                  However, dlsym wants us to omit the leading underscore from the
1165                  symbol name. For now, we simply strip it off here (and ONLY
1166                  here).
1167         */
1168         ASSERT(lbl[0] == '_');
1169         return dlsym(dl_prog_handle, lbl+1);
1170 #       else
1171         if(NSIsSymbolNameDefined(lbl)) {
1172             NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1173             return NSAddressOfSymbol(symbol);
1174         } else {
1175             return NULL;
1176         }
1177 #       endif /* HAVE_DLFCN_H */
1178 #       elif defined(OBJFORMAT_PEi386)
1179         OpenedDLL* o_dll;
1180         void* sym;
1181         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1182           /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
1183            if (lbl[0] == '_') {
1184               /* HACK: if the name has an initial underscore, try stripping
1185                  it off & look that up first. I've yet to verify whether there's
1186                  a Rule that governs whether an initial '_' *should always* be
1187                  stripped off when mapping from import lib name to the DLL name.
1188               */
1189               sym = GetProcAddress(o_dll->instance, (lbl+1));
1190               if (sym != NULL) {
1191                 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
1192                 return sym;
1193               }
1194            }
1195            sym = GetProcAddress(o_dll->instance, lbl);
1196            if (sym != NULL) {
1197              /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
1198              return sym;
1199            }
1200         }
1201         return NULL;
1202 #       else
1203         ASSERT(2+2 == 5);
1204         return NULL;
1205 #       endif
1206     } else {
1207         return val;
1208     }
1209 }
1210
1211 /* -----------------------------------------------------------------------------
1212  * Debugging aid: look in GHCi's object symbol tables for symbols
1213  * within DELTA bytes of the specified address, and show their names.
1214  */
1215 #ifdef DEBUG
1216 void ghci_enquire ( char* addr );
1217
1218 void ghci_enquire ( char* addr )
1219 {
1220    int   i;
1221    char* sym;
1222    char* a;
1223    const int DELTA = 64;
1224    ObjectCode* oc;
1225
1226    initLinker();
1227
1228    for (oc = objects; oc; oc = oc->next) {
1229       for (i = 0; i < oc->n_symbols; i++) {
1230          sym = oc->symbols[i];
1231          if (sym == NULL) continue;
1232          a = NULL;
1233          if (a == NULL) {
1234             a = lookupStrHashTable(symhash, sym);
1235          }
1236          if (a == NULL) {
1237              // debugBelch("ghci_enquire: can't find %s\n", sym);
1238          }
1239          else if (addr-DELTA <= a && a <= addr+DELTA) {
1240             debugBelch("%p + %3d  ==  `%s'\n", addr, (int)(a - addr), sym);
1241          }
1242       }
1243    }
1244 }
1245 #endif
1246
1247 #ifdef ia64_HOST_ARCH
1248 static unsigned int PLTSize(void);
1249 #endif
1250
1251 /* -----------------------------------------------------------------------------
1252  * Load an obj (populate the global symbol table, but don't resolve yet)
1253  *
1254  * Returns: 1 if ok, 0 on error.
1255  */
1256 HsInt
1257 loadObj( char *path )
1258 {
1259    ObjectCode* oc;
1260    struct stat st;
1261    int r, n;
1262 #ifdef USE_MMAP
1263    int fd, pagesize;
1264    void *map_addr = NULL;
1265 #else
1266    FILE *f;
1267 #endif
1268    initLinker();
1269
1270    /* debugBelch("loadObj %s\n", path ); */
1271
1272    /* Check that we haven't already loaded this object.
1273       Ignore requests to load multiple times */
1274    {
1275        ObjectCode *o;
1276        int is_dup = 0;
1277        for (o = objects; o; o = o->next) {
1278           if (0 == strcmp(o->fileName, path)) {
1279              is_dup = 1;
1280              break; /* don't need to search further */
1281           }
1282        }
1283        if (is_dup) {
1284           IF_DEBUG(linker, debugBelch(
1285             "GHCi runtime linker: warning: looks like you're trying to load the\n"
1286             "same object file twice:\n"
1287             "   %s\n"
1288             "GHCi will ignore this, but be warned.\n"
1289             , path));
1290           return 1; /* success */
1291        }
1292    }
1293
1294    oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1295
1296 #  if defined(OBJFORMAT_ELF)
1297    oc->formatName = "ELF";
1298 #  elif defined(OBJFORMAT_PEi386)
1299    oc->formatName = "PEi386";
1300 #  elif defined(OBJFORMAT_MACHO)
1301    oc->formatName = "Mach-O";
1302 #  else
1303    stgFree(oc);
1304    barf("loadObj: not implemented on this platform");
1305 #  endif
1306
1307    r = stat(path, &st);
1308    if (r == -1) { return 0; }
1309
1310    /* sigh, strdup() isn't a POSIX function, so do it the long way */
1311    oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1312    strcpy(oc->fileName, path);
1313
1314    oc->fileSize          = st.st_size;
1315    oc->symbols           = NULL;
1316    oc->sections          = NULL;
1317    oc->proddables        = NULL;
1318
1319    /* chain it onto the list of objects */
1320    oc->next              = objects;
1321    objects               = oc;
1322
1323 #ifdef USE_MMAP
1324 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1325
1326    /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1327
1328 #if defined(openbsd_HOST_OS)
1329    fd = open(path, O_RDONLY, S_IRUSR);
1330 #else
1331    fd = open(path, O_RDONLY);
1332 #endif
1333    if (fd == -1)
1334       barf("loadObj: can't open `%s'", path);
1335
1336    pagesize = getpagesize();
1337
1338 #ifdef ia64_HOST_ARCH
1339    /* The PLT needs to be right before the object */
1340    n = ROUND_UP(PLTSize(), pagesize);
1341    oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1342    if (oc->plt == MAP_FAILED)
1343       barf("loadObj: can't allocate PLT");
1344
1345    oc->pltIndex = 0;
1346    map_addr = oc->plt + n;
1347 #endif
1348
1349    n = ROUND_UP(oc->fileSize, pagesize);
1350
1351    /* Link objects into the lower 2Gb on x86_64.  GHC assumes the
1352     * small memory model on this architecture (see gcc docs,
1353     * -mcmodel=small).
1354     *
1355     * MAP_32BIT not available on OpenBSD/amd64
1356     */
1357 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
1358 #define EXTRA_MAP_FLAGS MAP_32BIT
1359 #else
1360 #define EXTRA_MAP_FLAGS 0
1361 #endif
1362
1363    /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
1364 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
1365 #define MAP_ANONYMOUS MAP_ANON
1366 #endif
1367
1368    oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1369                     MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1370    if (oc->image == MAP_FAILED)
1371       barf("loadObj: can't map `%s'", path);
1372
1373    close(fd);
1374
1375 #else /* !USE_MMAP */
1376
1377    /* load the image into memory */
1378    f = fopen(path, "rb");
1379    if (!f)
1380        barf("loadObj: can't read `%s'", path);
1381
1382 #   if defined(mingw32_HOST_OS)
1383         // TODO: We would like to use allocateExec here, but allocateExec
1384         //       cannot currently allocate blocks large enough.
1385     oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
1386                              PAGE_EXECUTE_READWRITE);
1387 #   elif defined(darwin_HOST_OS)
1388     // In a Mach-O .o file, all sections can and will be misaligned
1389     // if the total size of the headers is not a multiple of the
1390     // desired alignment. This is fine for .o files that only serve
1391     // as input for the static linker, but it's not fine for us,
1392     // as SSE (used by gcc for floating point) and Altivec require
1393     // 16-byte alignment.
1394     // We calculate the correct alignment from the header before
1395     // reading the file, and then we misalign oc->image on purpose so
1396     // that the actual sections end up aligned again.
1397    oc->misalignment = machoGetMisalignment(f);
1398    oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
1399    oc->image += oc->misalignment;
1400 #  else
1401    oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1402 #  endif
1403
1404    n = fread ( oc->image, 1, oc->fileSize, f );
1405    if (n != oc->fileSize)
1406       barf("loadObj: error whilst reading `%s'", path);
1407
1408    fclose(f);
1409 #endif /* USE_MMAP */
1410
1411 #  if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1412    r = ocAllocateSymbolExtras_MachO ( oc );
1413    if (!r) { return r; }
1414 #  elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1415    r = ocAllocateSymbolExtras_ELF ( oc );
1416    if (!r) { return r; }
1417 #endif
1418
1419    /* verify the in-memory image */
1420 #  if defined(OBJFORMAT_ELF)
1421    r = ocVerifyImage_ELF ( oc );
1422 #  elif defined(OBJFORMAT_PEi386)
1423    r = ocVerifyImage_PEi386 ( oc );
1424 #  elif defined(OBJFORMAT_MACHO)
1425    r = ocVerifyImage_MachO ( oc );
1426 #  else
1427    barf("loadObj: no verify method");
1428 #  endif
1429    if (!r) { return r; }
1430
1431    /* build the symbol list for this image */
1432 #  if defined(OBJFORMAT_ELF)
1433    r = ocGetNames_ELF ( oc );
1434 #  elif defined(OBJFORMAT_PEi386)
1435    r = ocGetNames_PEi386 ( oc );
1436 #  elif defined(OBJFORMAT_MACHO)
1437    r = ocGetNames_MachO ( oc );
1438 #  else
1439    barf("loadObj: no getNames method");
1440 #  endif
1441    if (!r) { return r; }
1442
1443    /* loaded, but not resolved yet */
1444    oc->status = OBJECT_LOADED;
1445
1446    return 1;
1447 }
1448
1449 /* -----------------------------------------------------------------------------
1450  * resolve all the currently unlinked objects in memory
1451  *
1452  * Returns: 1 if ok, 0 on error.
1453  */
1454 HsInt
1455 resolveObjs( void )
1456 {
1457     ObjectCode *oc;
1458     int r;
1459
1460     initLinker();
1461
1462     for (oc = objects; oc; oc = oc->next) {
1463         if (oc->status != OBJECT_RESOLVED) {
1464 #           if defined(OBJFORMAT_ELF)
1465             r = ocResolve_ELF ( oc );
1466 #           elif defined(OBJFORMAT_PEi386)
1467             r = ocResolve_PEi386 ( oc );
1468 #           elif defined(OBJFORMAT_MACHO)
1469             r = ocResolve_MachO ( oc );
1470 #           else
1471             barf("resolveObjs: not implemented on this platform");
1472 #           endif
1473             if (!r) { return r; }
1474             oc->status = OBJECT_RESOLVED;
1475         }
1476     }
1477     return 1;
1478 }
1479
1480 /* -----------------------------------------------------------------------------
1481  * delete an object from the pool
1482  */
1483 HsInt
1484 unloadObj( char *path )
1485 {
1486     ObjectCode *oc, *prev;
1487
1488     ASSERT(symhash != NULL);
1489     ASSERT(objects != NULL);
1490
1491     initLinker();
1492
1493     prev = NULL;
1494     for (oc = objects; oc; prev = oc, oc = oc->next) {
1495         if (!strcmp(oc->fileName,path)) {
1496
1497             /* Remove all the mappings for the symbols within this
1498              * object..
1499              */
1500             {
1501                 int i;
1502                 for (i = 0; i < oc->n_symbols; i++) {
1503                    if (oc->symbols[i] != NULL) {
1504                        removeStrHashTable(symhash, oc->symbols[i], NULL);
1505                    }
1506                 }
1507             }
1508
1509             if (prev == NULL) {
1510                 objects = oc->next;
1511             } else {
1512                 prev->next = oc->next;
1513             }
1514
1515             // We're going to leave this in place, in case there are
1516             // any pointers from the heap into it:
1517                 // #ifdef mingw32_HOST_OS
1518                 //  VirtualFree(oc->image);
1519                 // #else
1520             //  stgFree(oc->image);
1521             // #endif
1522             stgFree(oc->fileName);
1523             stgFree(oc->symbols);
1524             stgFree(oc->sections);
1525             stgFree(oc);
1526             return 1;
1527         }
1528     }
1529
1530     errorBelch("unloadObj: can't find `%s' to unload", path);
1531     return 0;
1532 }
1533
1534 /* -----------------------------------------------------------------------------
1535  * Sanity checking.  For each ObjectCode, maintain a list of address ranges
1536  * which may be prodded during relocation, and abort if we try and write
1537  * outside any of these.
1538  */
1539 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1540 {
1541    ProddableBlock* pb
1542       = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1543    /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1544    ASSERT(size > 0);
1545    pb->start      = start;
1546    pb->size       = size;
1547    pb->next       = oc->proddables;
1548    oc->proddables = pb;
1549 }
1550
1551 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1552 {
1553    ProddableBlock* pb;
1554    for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1555       char* s = (char*)(pb->start);
1556       char* e = s + pb->size - 1;
1557       char* a = (char*)addr;
1558       /* Assumes that the biggest fixup involves a 4-byte write.  This
1559          probably needs to be changed to 8 (ie, +7) on 64-bit
1560          plats. */
1561       if (a >= s && (a+3) <= e) return;
1562    }
1563    barf("checkProddableBlock: invalid fixup in runtime linker");
1564 }
1565
1566 /* -----------------------------------------------------------------------------
1567  * Section management.
1568  */
1569 static void addSection ( ObjectCode* oc, SectionKind kind,
1570                          void* start, void* end )
1571 {
1572    Section* s   = stgMallocBytes(sizeof(Section), "addSection");
1573    s->start     = start;
1574    s->end       = end;
1575    s->kind      = kind;
1576    s->next      = oc->sections;
1577    oc->sections = s;
1578    /*
1579    debugBelch("addSection: %p-%p (size %d), kind %d\n",
1580                    start, ((char*)end)-1, end - start + 1, kind );
1581    */
1582 }
1583
1584
1585 /* --------------------------------------------------------------------------
1586  * Symbol Extras.
1587  * This is about allocating a small chunk of memory for every symbol in the
1588  * object file. We make sure that the SymboLExtras are always "in range" of
1589  * limited-range PC-relative instructions on various platforms by allocating
1590  * them right next to the object code itself.
1591  */
1592
1593 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
1594
1595 /*
1596   ocAllocateSymbolExtras
1597
1598   Allocate additional space at the end of the object file image to make room
1599   for jump islands (powerpc, x86_64) and GOT entries (x86_64).
1600
1601   PowerPC relative branch instructions have a 24 bit displacement field.
1602   As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1603   If a particular imported symbol is outside this range, we have to redirect
1604   the jump to a short piece of new code that just loads the 32bit absolute
1605   address and jumps there.
1606   On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
1607   to 32 bits (+-2GB).
1608
1609   This function just allocates space for one SymbolExtra for every
1610   undefined symbol in the object file. The code for the jump islands is
1611   filled in by makeSymbolExtra below.
1612 */
1613
1614 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
1615 {
1616 #ifdef USE_MMAP
1617   int pagesize, n, m;
1618 #endif
1619   int aligned;
1620 #ifndef USE_MMAP
1621   int misalignment = 0;
1622 #ifdef darwin_HOST_OS
1623   misalignment = oc->misalignment;
1624 #endif
1625 #endif
1626
1627   if( count > 0 )
1628   {
1629     // round up to the nearest 4
1630     aligned = (oc->fileSize + 3) & ~3;
1631
1632 #ifdef USE_MMAP
1633     pagesize = getpagesize();
1634     n = ROUND_UP( oc->fileSize, pagesize );
1635     m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
1636
1637     /* we try to use spare space at the end of the last page of the
1638      * image for the jump islands, but if there isn't enough space
1639      * then we have to map some (anonymously, remembering MAP_32BIT).
1640      */
1641     if( m > n ) // we need to allocate more pages
1642     {
1643         oc->symbol_extras = mmap (NULL, sizeof(SymbolExtra) * count,
1644                                   PROT_EXEC|PROT_READ|PROT_WRITE,
1645                                   MAP_PRIVATE|MAP_ANONYMOUS|EXTRA_MAP_FLAGS,
1646                                   0, 0);
1647         if (oc->symbol_extras == MAP_FAILED)
1648         {
1649             errorBelch( "Unable to mmap() for jump islands\n" );
1650             return 0;
1651         }
1652 #ifdef x86_64_HOST_ARCH
1653         if ((StgWord)oc->symbol_extras > 0x80000000)
1654         {
1655             barf("mmap() returned memory outside 2Gb");
1656         }
1657 #endif
1658     }
1659     else
1660     {
1661         oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
1662     }
1663 #else
1664     oc->image -= misalignment;
1665     oc->image = stgReallocBytes( oc->image,
1666                                  misalignment +
1667                                  aligned + sizeof (SymbolExtra) * count,
1668                                  "ocAllocateSymbolExtras" );
1669     oc->image += misalignment;
1670
1671     oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
1672 #endif /* USE_MMAP */
1673
1674     memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
1675   }
1676   else
1677     oc->symbol_extras = NULL;
1678
1679   oc->first_symbol_extra = first;
1680   oc->n_symbol_extras = count;
1681
1682   return 1;
1683 }
1684
1685 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
1686                                      unsigned long symbolNumber,
1687                                      unsigned long target )
1688 {
1689   SymbolExtra *extra;
1690
1691   ASSERT( symbolNumber >= oc->first_symbol_extra
1692         && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
1693
1694   extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
1695
1696 #ifdef powerpc_HOST_ARCH
1697   // lis r12, hi16(target)
1698   extra->jumpIsland.lis_r12     = 0x3d80;
1699   extra->jumpIsland.hi_addr     = target >> 16;
1700
1701   // ori r12, r12, lo16(target)
1702   extra->jumpIsland.ori_r12_r12 = 0x618c;
1703   extra->jumpIsland.lo_addr     = target & 0xffff;
1704
1705   // mtctr r12
1706   extra->jumpIsland.mtctr_r12   = 0x7d8903a6;
1707
1708   // bctr
1709   extra->jumpIsland.bctr        = 0x4e800420;
1710 #endif
1711 #ifdef x86_64_HOST_ARCH
1712         // jmp *-14(%rip)
1713   static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
1714   extra->addr = target;
1715   memcpy(extra->jumpIsland, jmp, 6);
1716 #endif
1717
1718   return extra;
1719 }
1720
1721 #endif
1722
1723 /* --------------------------------------------------------------------------
1724  * PowerPC specifics (instruction cache flushing)
1725  * ------------------------------------------------------------------------*/
1726
1727 #ifdef powerpc_TARGET_ARCH
1728 /*
1729    ocFlushInstructionCache
1730
1731    Flush the data & instruction caches.
1732    Because the PPC has split data/instruction caches, we have to
1733    do that whenever we modify code at runtime.
1734  */
1735
1736 static void ocFlushInstructionCache( ObjectCode *oc )
1737 {
1738     int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
1739     unsigned long *p = (unsigned long *) oc->image;
1740
1741     while( n-- )
1742     {
1743         __asm__ volatile ( "dcbf 0,%0\n\t"
1744                            "sync\n\t"
1745                            "icbi 0,%0"
1746                            :
1747                            : "r" (p)
1748                          );
1749         p++;
1750     }
1751     __asm__ volatile ( "sync\n\t"
1752                        "isync"
1753                      );
1754 }
1755 #endif
1756
1757 /* --------------------------------------------------------------------------
1758  * PEi386 specifics (Win32 targets)
1759  * ------------------------------------------------------------------------*/
1760
1761 /* The information for this linker comes from
1762       Microsoft Portable Executable
1763       and Common Object File Format Specification
1764       revision 5.1 January 1998
1765    which SimonM says comes from the MS Developer Network CDs.
1766
1767    It can be found there (on older CDs), but can also be found
1768    online at:
1769
1770       http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1771
1772    (this is Rev 6.0 from February 1999).
1773
1774    Things move, so if that fails, try searching for it via
1775
1776       http://www.google.com/search?q=PE+COFF+specification
1777
1778    The ultimate reference for the PE format is the Winnt.h
1779    header file that comes with the Platform SDKs; as always,
1780    implementations will drift wrt their documentation.
1781
1782    A good background article on the PE format is Matt Pietrek's
1783    March 1994 article in Microsoft System Journal (MSJ)
1784    (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1785    Win32 Portable Executable File Format." The info in there
1786    has recently been updated in a two part article in
1787    MSDN magazine, issues Feb and March 2002,
1788    "Inside Windows: An In-Depth Look into the Win32 Portable
1789    Executable File Format"
1790
1791    John Levine's book "Linkers and Loaders" contains useful
1792    info on PE too.
1793 */
1794
1795
1796 #if defined(OBJFORMAT_PEi386)
1797
1798
1799
1800 typedef unsigned char  UChar;
1801 typedef unsigned short UInt16;
1802 typedef unsigned int   UInt32;
1803 typedef          int   Int32;
1804
1805
1806 typedef
1807    struct {
1808       UInt16 Machine;
1809       UInt16 NumberOfSections;
1810       UInt32 TimeDateStamp;
1811       UInt32 PointerToSymbolTable;
1812       UInt32 NumberOfSymbols;
1813       UInt16 SizeOfOptionalHeader;
1814       UInt16 Characteristics;
1815    }
1816    COFF_header;
1817
1818 #define sizeof_COFF_header 20
1819
1820
1821 typedef
1822    struct {
1823       UChar  Name[8];
1824       UInt32 VirtualSize;
1825       UInt32 VirtualAddress;
1826       UInt32 SizeOfRawData;
1827       UInt32 PointerToRawData;
1828       UInt32 PointerToRelocations;
1829       UInt32 PointerToLinenumbers;
1830       UInt16 NumberOfRelocations;
1831       UInt16 NumberOfLineNumbers;
1832       UInt32 Characteristics;
1833    }
1834    COFF_section;
1835
1836 #define sizeof_COFF_section 40
1837
1838
1839 typedef
1840    struct {
1841       UChar  Name[8];
1842       UInt32 Value;
1843       UInt16 SectionNumber;
1844       UInt16 Type;
1845       UChar  StorageClass;
1846       UChar  NumberOfAuxSymbols;
1847    }
1848    COFF_symbol;
1849
1850 #define sizeof_COFF_symbol 18
1851
1852
1853 typedef
1854    struct {
1855       UInt32 VirtualAddress;
1856       UInt32 SymbolTableIndex;
1857       UInt16 Type;
1858    }
1859    COFF_reloc;
1860
1861 #define sizeof_COFF_reloc 10
1862
1863
1864 /* From PE spec doc, section 3.3.2 */
1865 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1866    windows.h -- for the same purpose, but I want to know what I'm
1867    getting, here. */
1868 #define MYIMAGE_FILE_RELOCS_STRIPPED     0x0001
1869 #define MYIMAGE_FILE_EXECUTABLE_IMAGE    0x0002
1870 #define MYIMAGE_FILE_DLL                 0x2000
1871 #define MYIMAGE_FILE_SYSTEM              0x1000
1872 #define MYIMAGE_FILE_BYTES_REVERSED_HI   0x8000
1873 #define MYIMAGE_FILE_BYTES_REVERSED_LO   0x0080
1874 #define MYIMAGE_FILE_32BIT_MACHINE       0x0100
1875
1876 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1877 #define MYIMAGE_SYM_CLASS_EXTERNAL       2
1878 #define MYIMAGE_SYM_CLASS_STATIC         3
1879 #define MYIMAGE_SYM_UNDEFINED            0
1880
1881 /* From PE spec doc, section 4.1 */
1882 #define MYIMAGE_SCN_CNT_CODE             0x00000020
1883 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1884 #define MYIMAGE_SCN_LNK_NRELOC_OVFL      0x01000000
1885
1886 /* From PE spec doc, section 5.2.1 */
1887 #define MYIMAGE_REL_I386_DIR32           0x0006
1888 #define MYIMAGE_REL_I386_REL32           0x0014
1889
1890
1891 /* We use myindex to calculate array addresses, rather than
1892    simply doing the normal subscript thing.  That's because
1893    some of the above structs have sizes which are not
1894    a whole number of words.  GCC rounds their sizes up to a
1895    whole number of words, which means that the address calcs
1896    arising from using normal C indexing or pointer arithmetic
1897    are just plain wrong.  Sigh.
1898 */
1899 static UChar *
1900 myindex ( int scale, void* base, int index )
1901 {
1902    return
1903       ((UChar*)base) + scale * index;
1904 }
1905
1906
1907 static void
1908 printName ( UChar* name, UChar* strtab )
1909 {
1910    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1911       UInt32 strtab_offset = * (UInt32*)(name+4);
1912       debugBelch("%s", strtab + strtab_offset );
1913    } else {
1914       int i;
1915       for (i = 0; i < 8; i++) {
1916          if (name[i] == 0) break;
1917          debugBelch("%c", name[i] );
1918       }
1919    }
1920 }
1921
1922
1923 static void
1924 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1925 {
1926    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1927       UInt32 strtab_offset = * (UInt32*)(name+4);
1928       strncpy ( dst, strtab+strtab_offset, dstSize );
1929       dst[dstSize-1] = 0;
1930    } else {
1931       int i = 0;
1932       while (1) {
1933          if (i >= 8) break;
1934          if (name[i] == 0) break;
1935          dst[i] = name[i];
1936          i++;
1937       }
1938       dst[i] = 0;
1939    }
1940 }
1941
1942
1943 static UChar *
1944 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1945 {
1946    UChar* newstr;
1947    /* If the string is longer than 8 bytes, look in the
1948       string table for it -- this will be correctly zero terminated.
1949    */
1950    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1951       UInt32 strtab_offset = * (UInt32*)(name+4);
1952       return ((UChar*)strtab) + strtab_offset;
1953    }
1954    /* Otherwise, if shorter than 8 bytes, return the original,
1955       which by defn is correctly terminated.
1956    */
1957    if (name[7]==0) return name;
1958    /* The annoying case: 8 bytes.  Copy into a temporary
1959       (which is never freed ...)
1960    */
1961    newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1962    ASSERT(newstr);
1963    strncpy(newstr,name,8);
1964    newstr[8] = 0;
1965    return newstr;
1966 }
1967
1968
1969 /* Just compares the short names (first 8 chars) */
1970 static COFF_section *
1971 findPEi386SectionCalled ( ObjectCode* oc,  char* name )
1972 {
1973    int i;
1974    COFF_header* hdr
1975       = (COFF_header*)(oc->image);
1976    COFF_section* sectab
1977       = (COFF_section*) (
1978            ((UChar*)(oc->image))
1979            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1980         );
1981    for (i = 0; i < hdr->NumberOfSections; i++) {
1982       UChar* n1;
1983       UChar* n2;
1984       COFF_section* section_i
1985          = (COFF_section*)
1986            myindex ( sizeof_COFF_section, sectab, i );
1987       n1 = (UChar*) &(section_i->Name);
1988       n2 = name;
1989       if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1990           n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1991           n1[6]==n2[6] && n1[7]==n2[7])
1992          return section_i;
1993    }
1994
1995    return NULL;
1996 }
1997
1998
1999 static void
2000 zapTrailingAtSign ( UChar* sym )
2001 {
2002 #  define my_isdigit(c) ((c) >= '0' && (c) <= '9')
2003    int i, j;
2004    if (sym[0] == 0) return;
2005    i = 0;
2006    while (sym[i] != 0) i++;
2007    i--;
2008    j = i;
2009    while (j > 0 && my_isdigit(sym[j])) j--;
2010    if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
2011 #  undef my_isdigit
2012 }
2013
2014
2015 static int
2016 ocVerifyImage_PEi386 ( ObjectCode* oc )
2017 {
2018    int i;
2019    UInt32 j, noRelocs;
2020    COFF_header*  hdr;
2021    COFF_section* sectab;
2022    COFF_symbol*  symtab;
2023    UChar*        strtab;
2024    /* debugBelch("\nLOADING %s\n", oc->fileName); */
2025    hdr = (COFF_header*)(oc->image);
2026    sectab = (COFF_section*) (
2027                ((UChar*)(oc->image))
2028                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2029             );
2030    symtab = (COFF_symbol*) (
2031                ((UChar*)(oc->image))
2032                + hdr->PointerToSymbolTable
2033             );
2034    strtab = ((UChar*)symtab)
2035             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2036
2037    if (hdr->Machine != 0x14c) {
2038       errorBelch("%s: Not x86 PEi386", oc->fileName);
2039       return 0;
2040    }
2041    if (hdr->SizeOfOptionalHeader != 0) {
2042       errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
2043       return 0;
2044    }
2045    if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
2046         (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
2047         (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
2048         (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
2049       errorBelch("%s: Not a PEi386 object file", oc->fileName);
2050       return 0;
2051    }
2052    if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
2053         /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
2054       errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
2055                  oc->fileName,
2056                  (int)(hdr->Characteristics));
2057       return 0;
2058    }
2059    /* If the string table size is way crazy, this might indicate that
2060       there are more than 64k relocations, despite claims to the
2061       contrary.  Hence this test. */
2062    /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
2063 #if 0
2064    if ( (*(UInt32*)strtab) > 600000 ) {
2065       /* Note that 600k has no special significance other than being
2066          big enough to handle the almost-2MB-sized lumps that
2067          constitute HSwin32*.o. */
2068       debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
2069       return 0;
2070    }
2071 #endif
2072
2073    /* No further verification after this point; only debug printing. */
2074    i = 0;
2075    IF_DEBUG(linker, i=1);
2076    if (i == 0) return 1;
2077
2078    debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
2079    debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
2080    debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
2081
2082    debugBelch("\n" );
2083    debugBelch( "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
2084    debugBelch( "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
2085    debugBelch( "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
2086    debugBelch( "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
2087    debugBelch( "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
2088    debugBelch( "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
2089    debugBelch( "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
2090
2091    /* Print the section table. */
2092    debugBelch("\n" );
2093    for (i = 0; i < hdr->NumberOfSections; i++) {
2094       COFF_reloc* reltab;
2095       COFF_section* sectab_i
2096          = (COFF_section*)
2097            myindex ( sizeof_COFF_section, sectab, i );
2098       debugBelch(
2099                 "\n"
2100                 "section %d\n"
2101                 "     name `",
2102                 i
2103               );
2104       printName ( sectab_i->Name, strtab );
2105       debugBelch(
2106                 "'\n"
2107                 "    vsize %d\n"
2108                 "    vaddr %d\n"
2109                 "  data sz %d\n"
2110                 " data off %d\n"
2111                 "  num rel %d\n"
2112                 "  off rel %d\n"
2113                 "  ptr raw 0x%x\n",
2114                 sectab_i->VirtualSize,
2115                 sectab_i->VirtualAddress,
2116                 sectab_i->SizeOfRawData,
2117                 sectab_i->PointerToRawData,
2118                 sectab_i->NumberOfRelocations,
2119                 sectab_i->PointerToRelocations,
2120                 sectab_i->PointerToRawData
2121               );
2122       reltab = (COFF_reloc*) (
2123                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2124                );
2125
2126       if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2127         /* If the relocation field (a short) has overflowed, the
2128          * real count can be found in the first reloc entry.
2129          *
2130          * See Section 4.1 (last para) of the PE spec (rev6.0).
2131          */
2132         COFF_reloc* rel = (COFF_reloc*)
2133                            myindex ( sizeof_COFF_reloc, reltab, 0 );
2134         noRelocs = rel->VirtualAddress;
2135         j = 1;
2136       } else {
2137         noRelocs = sectab_i->NumberOfRelocations;
2138         j = 0;
2139       }
2140
2141       for (; j < noRelocs; j++) {
2142          COFF_symbol* sym;
2143          COFF_reloc* rel = (COFF_reloc*)
2144                            myindex ( sizeof_COFF_reloc, reltab, j );
2145          debugBelch(
2146                    "        type 0x%-4x   vaddr 0x%-8x   name `",
2147                    (UInt32)rel->Type,
2148                    rel->VirtualAddress );
2149          sym = (COFF_symbol*)
2150                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
2151          /* Hmm..mysterious looking offset - what's it for? SOF */
2152          printName ( sym->Name, strtab -10 );
2153          debugBelch("'\n" );
2154       }
2155
2156       debugBelch("\n" );
2157    }
2158    debugBelch("\n" );
2159    debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2160    debugBelch("---START of string table---\n");
2161    for (i = 4; i < *(Int32*)strtab; i++) {
2162       if (strtab[i] == 0)
2163          debugBelch("\n"); else
2164          debugBelch("%c", strtab[i] );
2165    }
2166    debugBelch("--- END  of string table---\n");
2167
2168    debugBelch("\n" );
2169    i = 0;
2170    while (1) {
2171       COFF_symbol* symtab_i;
2172       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2173       symtab_i = (COFF_symbol*)
2174                  myindex ( sizeof_COFF_symbol, symtab, i );
2175       debugBelch(
2176                 "symbol %d\n"
2177                 "     name `",
2178                 i
2179               );
2180       printName ( symtab_i->Name, strtab );
2181       debugBelch(
2182                 "'\n"
2183                 "    value 0x%x\n"
2184                 "   1+sec# %d\n"
2185                 "     type 0x%x\n"
2186                 "   sclass 0x%x\n"
2187                 "     nAux %d\n",
2188                 symtab_i->Value,
2189                 (Int32)(symtab_i->SectionNumber),
2190                 (UInt32)symtab_i->Type,
2191                 (UInt32)symtab_i->StorageClass,
2192                 (UInt32)symtab_i->NumberOfAuxSymbols
2193               );
2194       i += symtab_i->NumberOfAuxSymbols;
2195       i++;
2196    }
2197
2198    debugBelch("\n" );
2199    return 1;
2200 }
2201
2202
2203 static int
2204 ocGetNames_PEi386 ( ObjectCode* oc )
2205 {
2206    COFF_header*  hdr;
2207    COFF_section* sectab;
2208    COFF_symbol*  symtab;
2209    UChar*        strtab;
2210
2211    UChar* sname;
2212    void*  addr;
2213    int    i;
2214
2215    hdr = (COFF_header*)(oc->image);
2216    sectab = (COFF_section*) (
2217                ((UChar*)(oc->image))
2218                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2219             );
2220    symtab = (COFF_symbol*) (
2221                ((UChar*)(oc->image))
2222                + hdr->PointerToSymbolTable
2223             );
2224    strtab = ((UChar*)(oc->image))
2225             + hdr->PointerToSymbolTable
2226             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2227
2228    /* Allocate space for any (local, anonymous) .bss sections. */
2229
2230    for (i = 0; i < hdr->NumberOfSections; i++) {
2231       UInt32 bss_sz;
2232       UChar* zspace;
2233       COFF_section* sectab_i
2234          = (COFF_section*)
2235            myindex ( sizeof_COFF_section, sectab, i );
2236       if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2237       /* sof 10/05: the PE spec text isn't too clear regarding what
2238        * the SizeOfRawData field is supposed to hold for object
2239        * file sections containing just uninitialized data -- for executables,
2240        * it is supposed to be zero; unclear what it's supposed to be
2241        * for object files. However, VirtualSize is guaranteed to be
2242        * zero for object files, which definitely suggests that SizeOfRawData
2243        * will be non-zero (where else would the size of this .bss section be
2244        * stored?) Looking at the COFF_section info for incoming object files,
2245        * this certainly appears to be the case.
2246        *
2247        * => I suspect we've been incorrectly handling .bss sections in (relocatable)
2248        * object files up until now. This turned out to bite us with ghc-6.4.1's use
2249        * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
2250        * variable decls into to the .bss section. (The specific function in Q which
2251        * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
2252        */
2253       if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
2254       /* This is a non-empty .bss section.  Allocate zeroed space for
2255          it, and set its PointerToRawData field such that oc->image +
2256          PointerToRawData == addr_of_zeroed_space.  */
2257       bss_sz = sectab_i->VirtualSize;
2258       if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
2259       zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
2260       sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2261       addProddableBlock(oc, zspace, bss_sz);
2262       /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2263    }
2264
2265    /* Copy section information into the ObjectCode. */
2266
2267    for (i = 0; i < hdr->NumberOfSections; i++) {
2268       UChar* start;
2269       UChar* end;
2270       UInt32 sz;
2271
2272       SectionKind kind
2273          = SECTIONKIND_OTHER;
2274       COFF_section* sectab_i
2275          = (COFF_section*)
2276            myindex ( sizeof_COFF_section, sectab, i );
2277       IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2278
2279 #     if 0
2280       /* I'm sure this is the Right Way to do it.  However, the
2281          alternative of testing the sectab_i->Name field seems to
2282          work ok with Cygwin.
2283       */
2284       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2285           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2286          kind = SECTIONKIND_CODE_OR_RODATA;
2287 #     endif
2288
2289       if (0==strcmp(".text",sectab_i->Name) ||
2290           0==strcmp(".rdata",sectab_i->Name)||
2291           0==strcmp(".rodata",sectab_i->Name))
2292          kind = SECTIONKIND_CODE_OR_RODATA;
2293       if (0==strcmp(".data",sectab_i->Name) ||
2294           0==strcmp(".bss",sectab_i->Name))
2295          kind = SECTIONKIND_RWDATA;
2296
2297       ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2298       sz = sectab_i->SizeOfRawData;
2299       if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2300
2301       start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2302       end   = start + sz - 1;
2303
2304       if (kind == SECTIONKIND_OTHER
2305           /* Ignore sections called which contain stabs debugging
2306              information. */
2307           && 0 != strcmp(".stab", sectab_i->Name)
2308           && 0 != strcmp(".stabstr", sectab_i->Name)
2309           /* ignore constructor section for now */
2310           && 0 != strcmp(".ctors", sectab_i->Name)
2311           /* ignore section generated from .ident */
2312           && 0!= strcmp("/4", sectab_i->Name)
2313           /* ignore unknown section that appeared in gcc 3.4.5(?) */
2314           && 0!= strcmp(".reloc", sectab_i->Name)
2315          ) {
2316          errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2317          return 0;
2318       }
2319
2320       if (kind != SECTIONKIND_OTHER && end >= start) {
2321          addSection(oc, kind, start, end);
2322          addProddableBlock(oc, start, end - start + 1);
2323       }
2324    }
2325
2326    /* Copy exported symbols into the ObjectCode. */
2327
2328    oc->n_symbols = hdr->NumberOfSymbols;
2329    oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
2330                                   "ocGetNames_PEi386(oc->symbols)");
2331    /* Call me paranoid; I don't care. */
2332    for (i = 0; i < oc->n_symbols; i++)
2333       oc->symbols[i] = NULL;
2334
2335    i = 0;
2336    while (1) {
2337       COFF_symbol* symtab_i;
2338       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2339       symtab_i = (COFF_symbol*)
2340                  myindex ( sizeof_COFF_symbol, symtab, i );
2341
2342       addr  = NULL;
2343
2344       if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2345           && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2346          /* This symbol is global and defined, viz, exported */
2347          /* for MYIMAGE_SYMCLASS_EXTERNAL
2348                 && !MYIMAGE_SYM_UNDEFINED,
2349             the address of the symbol is:
2350                 address of relevant section + offset in section
2351          */
2352          COFF_section* sectabent
2353             = (COFF_section*) myindex ( sizeof_COFF_section,
2354                                         sectab,
2355                                         symtab_i->SectionNumber-1 );
2356          addr = ((UChar*)(oc->image))
2357                 + (sectabent->PointerToRawData
2358                    + symtab_i->Value);
2359       }
2360       else
2361       if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2362           && symtab_i->Value > 0) {
2363          /* This symbol isn't in any section at all, ie, global bss.
2364             Allocate zeroed space for it. */
2365          addr = stgCallocBytes(1, symtab_i->Value,
2366                                "ocGetNames_PEi386(non-anonymous bss)");
2367          addSection(oc, SECTIONKIND_RWDATA, addr,
2368                         ((UChar*)addr) + symtab_i->Value - 1);
2369          addProddableBlock(oc, addr, symtab_i->Value);
2370          /* debugBelch("BSS      section at 0x%x\n", addr); */
2371       }
2372
2373       if (addr != NULL ) {
2374          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2375          /* debugBelch("addSymbol %p `%s \n", addr,sname);  */
2376          IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2377          ASSERT(i >= 0 && i < oc->n_symbols);
2378          /* cstring_from_COFF_symbol_name always succeeds. */
2379          oc->symbols[i] = sname;
2380          ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2381       } else {
2382 #        if 0
2383          debugBelch(
2384                    "IGNORING symbol %d\n"
2385                    "     name `",
2386                    i
2387                  );
2388          printName ( symtab_i->Name, strtab );
2389          debugBelch(
2390                    "'\n"
2391                    "    value 0x%x\n"
2392                    "   1+sec# %d\n"
2393                    "     type 0x%x\n"
2394                    "   sclass 0x%x\n"
2395                    "     nAux %d\n",
2396                    symtab_i->Value,
2397                    (Int32)(symtab_i->SectionNumber),
2398                    (UInt32)symtab_i->Type,
2399                    (UInt32)symtab_i->StorageClass,
2400                    (UInt32)symtab_i->NumberOfAuxSymbols
2401                  );
2402 #        endif
2403       }
2404
2405       i += symtab_i->NumberOfAuxSymbols;
2406       i++;
2407    }
2408
2409    return 1;
2410 }
2411
2412
2413 static int
2414 ocResolve_PEi386 ( ObjectCode* oc )
2415 {
2416    COFF_header*  hdr;
2417    COFF_section* sectab;
2418    COFF_symbol*  symtab;
2419    UChar*        strtab;
2420
2421    UInt32        A;
2422    UInt32        S;
2423    UInt32*       pP;
2424
2425    int i;
2426    UInt32 j, noRelocs;
2427
2428    /* ToDo: should be variable-sized?  But is at least safe in the
2429       sense of buffer-overrun-proof. */
2430    char symbol[1000];
2431    /* debugBelch("resolving for %s\n", oc->fileName); */
2432
2433    hdr = (COFF_header*)(oc->image);
2434    sectab = (COFF_section*) (
2435                ((UChar*)(oc->image))
2436                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2437             );
2438    symtab = (COFF_symbol*) (
2439                ((UChar*)(oc->image))
2440                + hdr->PointerToSymbolTable
2441             );
2442    strtab = ((UChar*)(oc->image))
2443             + hdr->PointerToSymbolTable
2444             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2445
2446    for (i = 0; i < hdr->NumberOfSections; i++) {
2447       COFF_section* sectab_i
2448          = (COFF_section*)
2449            myindex ( sizeof_COFF_section, sectab, i );
2450       COFF_reloc* reltab
2451          = (COFF_reloc*) (
2452               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2453            );
2454
2455       /* Ignore sections called which contain stabs debugging
2456          information. */
2457       if (0 == strcmp(".stab", sectab_i->Name)
2458           || 0 == strcmp(".stabstr", sectab_i->Name)
2459           || 0 == strcmp(".ctors", sectab_i->Name))
2460          continue;
2461
2462       if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2463         /* If the relocation field (a short) has overflowed, the
2464          * real count can be found in the first reloc entry.
2465          *
2466          * See Section 4.1 (last para) of the PE spec (rev6.0).
2467          *
2468          * Nov2003 update: the GNU linker still doesn't correctly
2469          * handle the generation of relocatable object files with
2470          * overflown relocations. Hence the output to warn of potential
2471          * troubles.
2472          */
2473         COFF_reloc* rel = (COFF_reloc*)
2474                            myindex ( sizeof_COFF_reloc, reltab, 0 );
2475         noRelocs = rel->VirtualAddress;
2476
2477         /* 10/05: we now assume (and check for) a GNU ld that is capable
2478          * of handling object files with (>2^16) of relocs.
2479          */
2480 #if 0
2481         debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2482                    noRelocs);
2483 #endif
2484         j = 1;
2485       } else {
2486         noRelocs = sectab_i->NumberOfRelocations;
2487         j = 0;
2488       }
2489
2490
2491       for (; j < noRelocs; j++) {
2492          COFF_symbol* sym;
2493          COFF_reloc* reltab_j
2494             = (COFF_reloc*)
2495               myindex ( sizeof_COFF_reloc, reltab, j );
2496
2497          /* the location to patch */
2498          pP = (UInt32*)(
2499                  ((UChar*)(oc->image))
2500                  + (sectab_i->PointerToRawData
2501                     + reltab_j->VirtualAddress
2502                     - sectab_i->VirtualAddress )
2503               );
2504          /* the existing contents of pP */
2505          A = *pP;
2506          /* the symbol to connect to */
2507          sym = (COFF_symbol*)
2508                myindex ( sizeof_COFF_symbol,
2509                          symtab, reltab_j->SymbolTableIndex );
2510          IF_DEBUG(linker,
2511                   debugBelch(
2512                             "reloc sec %2d num %3d:  type 0x%-4x   "
2513                             "vaddr 0x%-8x   name `",
2514                             i, j,
2515                             (UInt32)reltab_j->Type,
2516                             reltab_j->VirtualAddress );
2517                             printName ( sym->Name, strtab );
2518                             debugBelch("'\n" ));
2519
2520          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2521             COFF_section* section_sym
2522                = findPEi386SectionCalled ( oc, sym->Name );
2523             if (!section_sym) {
2524                errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2525                return 0;
2526             }
2527             S = ((UInt32)(oc->image))
2528                 + (section_sym->PointerToRawData
2529                    + sym->Value);
2530          } else {
2531             copyName ( sym->Name, strtab, symbol, 1000-1 );
2532             S = (UInt32) lookupSymbol( symbol );
2533             if ((void*)S != NULL) goto foundit;
2534             zapTrailingAtSign ( symbol );
2535             S = (UInt32) lookupSymbol( symbol );
2536             if ((void*)S != NULL) goto foundit;
2537             /* Newline first because the interactive linker has printed "linking..." */
2538             errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2539             return 0;
2540            foundit:;
2541          }
2542          checkProddableBlock(oc, pP);
2543          switch (reltab_j->Type) {
2544             case MYIMAGE_REL_I386_DIR32:
2545                *pP = A + S;
2546                break;
2547             case MYIMAGE_REL_I386_REL32:
2548                /* Tricky.  We have to insert a displacement at
2549                   pP which, when added to the PC for the _next_
2550                   insn, gives the address of the target (S).
2551                   Problem is to know the address of the next insn
2552                   when we only know pP.  We assume that this
2553                   literal field is always the last in the insn,
2554                   so that the address of the next insn is pP+4
2555                   -- hence the constant 4.
2556                   Also I don't know if A should be added, but so
2557                   far it has always been zero.
2558
2559                   SOF 05/2005: 'A' (old contents of *pP) have been observed
2560                   to contain values other than zero (the 'wx' object file
2561                   that came with wxhaskell-0.9.4; dunno how it was compiled..).
2562                   So, add displacement to old value instead of asserting
2563                   A to be zero. Fixes wxhaskell-related crashes, and no other
2564                   ill effects have been observed.
2565
2566                   Update: the reason why we're seeing these more elaborate
2567                   relocations is due to a switch in how the NCG compiles SRTs
2568                   and offsets to them from info tables. SRTs live in .(ro)data,
2569                   while info tables live in .text, causing GAS to emit REL32/DISP32
2570                   relocations with non-zero values. Adding the displacement is
2571                   the right thing to do.
2572                */
2573                *pP = S - ((UInt32)pP) - 4 + A;
2574                break;
2575             default:
2576                debugBelch("%s: unhandled PEi386 relocation type %d",
2577                      oc->fileName, reltab_j->Type);
2578                return 0;
2579          }
2580
2581       }
2582    }
2583
2584    IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2585    return 1;
2586 }
2587
2588 #endif /* defined(OBJFORMAT_PEi386) */
2589
2590
2591 /* --------------------------------------------------------------------------
2592  * ELF specifics
2593  * ------------------------------------------------------------------------*/
2594
2595 #if defined(OBJFORMAT_ELF)
2596
2597 #define FALSE 0
2598 #define TRUE  1
2599
2600 #if defined(sparc_HOST_ARCH)
2601 #  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
2602 #elif defined(i386_HOST_ARCH)
2603 #  define ELF_TARGET_386    /* Used inside <elf.h> */
2604 #elif defined(x86_64_HOST_ARCH)
2605 #  define ELF_TARGET_X64_64
2606 #  define ELF_64BIT
2607 #elif defined (ia64_HOST_ARCH)
2608 #  define ELF_TARGET_IA64   /* Used inside <elf.h> */
2609 #  define ELF_64BIT
2610 #  define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2611 #  define ELF_NEED_GOT      /* needs Global Offset Table */
2612 #  define ELF_NEED_PLT      /* needs Procedure Linkage Tables */
2613 #endif
2614
2615 #if !defined(openbsd_HOST_OS)
2616 #  include <elf.h>
2617 #else
2618 /* openbsd elf has things in different places, with diff names */
2619 #  include <elf_abi.h>
2620 #  include <machine/reloc.h>
2621 #  define R_386_32    RELOC_32
2622 #  define R_386_PC32  RELOC_PC32
2623 #endif
2624
2625 /* If elf.h doesn't define it */
2626 #  ifndef R_X86_64_PC64
2627 #    define R_X86_64_PC64 24
2628 #  endif
2629
2630 /*
2631  * Define a set of types which can be used for both ELF32 and ELF64
2632  */
2633
2634 #ifdef ELF_64BIT
2635 #define ELFCLASS    ELFCLASS64
2636 #define Elf_Addr    Elf64_Addr
2637 #define Elf_Word    Elf64_Word
2638 #define Elf_Sword   Elf64_Sword
2639 #define Elf_Ehdr    Elf64_Ehdr
2640 #define Elf_Phdr    Elf64_Phdr
2641 #define Elf_Shdr    Elf64_Shdr
2642 #define Elf_Sym     Elf64_Sym
2643 #define Elf_Rel     Elf64_Rel
2644 #define Elf_Rela    Elf64_Rela
2645 #define ELF_ST_TYPE ELF64_ST_TYPE
2646 #define ELF_ST_BIND ELF64_ST_BIND
2647 #define ELF_R_TYPE  ELF64_R_TYPE
2648 #define ELF_R_SYM   ELF64_R_SYM
2649 #else
2650 #define ELFCLASS    ELFCLASS32
2651 #define Elf_Addr    Elf32_Addr
2652 #define Elf_Word    Elf32_Word
2653 #define Elf_Sword   Elf32_Sword
2654 #define Elf_Ehdr    Elf32_Ehdr
2655 #define Elf_Phdr    Elf32_Phdr
2656 #define Elf_Shdr    Elf32_Shdr
2657 #define Elf_Sym     Elf32_Sym
2658 #define Elf_Rel     Elf32_Rel
2659 #define Elf_Rela    Elf32_Rela
2660 #ifndef ELF_ST_TYPE
2661 #define ELF_ST_TYPE ELF32_ST_TYPE
2662 #endif
2663 #ifndef ELF_ST_BIND
2664 #define ELF_ST_BIND ELF32_ST_BIND
2665 #endif
2666 #ifndef ELF_R_TYPE
2667 #define ELF_R_TYPE  ELF32_R_TYPE
2668 #endif
2669 #ifndef ELF_R_SYM
2670 #define ELF_R_SYM   ELF32_R_SYM
2671 #endif
2672 #endif
2673
2674
2675 /*
2676  * Functions to allocate entries in dynamic sections.  Currently we simply
2677  * preallocate a large number, and we don't check if a entry for the given
2678  * target already exists (a linear search is too slow).  Ideally these
2679  * entries would be associated with symbols.
2680  */
2681
2682 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2683 #define GOT_SIZE            0x20000
2684 #define FUNCTION_TABLE_SIZE 0x10000
2685 #define PLT_SIZE            0x08000
2686
2687 #ifdef ELF_NEED_GOT
2688 static Elf_Addr got[GOT_SIZE];
2689 static unsigned int gotIndex;
2690 static Elf_Addr gp_val = (Elf_Addr)got;
2691
2692 static Elf_Addr
2693 allocateGOTEntry(Elf_Addr target)
2694 {
2695    Elf_Addr *entry;
2696
2697    if (gotIndex >= GOT_SIZE)
2698       barf("Global offset table overflow");
2699
2700    entry = &got[gotIndex++];
2701    *entry = target;
2702    return (Elf_Addr)entry;
2703 }
2704 #endif
2705
2706 #ifdef ELF_FUNCTION_DESC
2707 typedef struct {
2708    Elf_Addr ip;
2709    Elf_Addr gp;
2710 } FunctionDesc;
2711
2712 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2713 static unsigned int functionTableIndex;
2714
2715 static Elf_Addr
2716 allocateFunctionDesc(Elf_Addr target)
2717 {
2718    FunctionDesc *entry;
2719
2720    if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2721       barf("Function table overflow");
2722
2723    entry = &functionTable[functionTableIndex++];
2724    entry->ip = target;
2725    entry->gp = (Elf_Addr)gp_val;
2726    return (Elf_Addr)entry;
2727 }
2728
2729 static Elf_Addr
2730 copyFunctionDesc(Elf_Addr target)
2731 {
2732    FunctionDesc *olddesc = (FunctionDesc *)target;
2733    FunctionDesc *newdesc;
2734
2735    newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2736    newdesc->gp = olddesc->gp;
2737    return (Elf_Addr)newdesc;
2738 }
2739 #endif
2740
2741 #ifdef ELF_NEED_PLT
2742 #ifdef ia64_HOST_ARCH
2743 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2744 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2745
2746 static unsigned char plt_code[] =
2747 {
2748    /* taken from binutils bfd/elfxx-ia64.c */
2749    0x0b, 0x78, 0x00, 0x02, 0x00, 0x24,  /*   [MMI]       addl r15=0,r1;;    */
2750    0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0,  /*               ld8 r16=[r15],8    */
2751    0x01, 0x08, 0x00, 0x84,              /*               mov r14=r1;;       */
2752    0x11, 0x08, 0x00, 0x1e, 0x18, 0x10,  /*   [MIB]       ld8 r1=[r15]       */
2753    0x60, 0x80, 0x04, 0x80, 0x03, 0x00,  /*               mov b6=r16         */
2754    0x60, 0x00, 0x80, 0x00               /*               br.few b6;;        */
2755 };
2756
2757 /* If we can't get to the function descriptor via gp, take a local copy of it */
2758 #define PLT_RELOC(code, target) { \
2759    Elf64_Sxword rel_value = target - gp_val; \
2760    if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2761       ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2762    else \
2763       ia64_reloc_gprel22((Elf_Addr)code, target); \
2764    }
2765 #endif
2766
2767 typedef struct {
2768    unsigned char code[sizeof(plt_code)];
2769 } PLTEntry;
2770
2771 static Elf_Addr
2772 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2773 {
2774    PLTEntry *plt = (PLTEntry *)oc->plt;
2775    PLTEntry *entry;
2776
2777    if (oc->pltIndex >= PLT_SIZE)
2778       barf("Procedure table overflow");
2779
2780    entry = &plt[oc->pltIndex++];
2781    memcpy(entry->code, plt_code, sizeof(entry->code));
2782    PLT_RELOC(entry->code, target);
2783    return (Elf_Addr)entry;
2784 }
2785
2786 static unsigned int
2787 PLTSize(void)
2788 {
2789    return (PLT_SIZE * sizeof(PLTEntry));
2790 }
2791 #endif
2792
2793
2794 /*
2795  * Generic ELF functions
2796  */
2797
2798 static char *
2799 findElfSection ( void* objImage, Elf_Word sh_type )
2800 {
2801    char* ehdrC = (char*)objImage;
2802    Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2803    Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2804    char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2805    char* ptr = NULL;
2806    int i;
2807
2808    for (i = 0; i < ehdr->e_shnum; i++) {
2809       if (shdr[i].sh_type == sh_type
2810           /* Ignore the section header's string table. */
2811           && i != ehdr->e_shstrndx
2812           /* Ignore string tables named .stabstr, as they contain
2813              debugging info. */
2814           && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2815          ) {
2816          ptr = ehdrC + shdr[i].sh_offset;
2817          break;
2818       }
2819    }
2820    return ptr;
2821 }
2822
2823 #if defined(ia64_HOST_ARCH)
2824 static Elf_Addr
2825 findElfSegment ( void* objImage, Elf_Addr vaddr )
2826 {
2827    char* ehdrC = (char*)objImage;
2828    Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2829    Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2830    Elf_Addr segaddr = 0;
2831    int i;
2832
2833    for (i = 0; i < ehdr->e_phnum; i++) {
2834       segaddr = phdr[i].p_vaddr;
2835       if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2836               break;
2837    }
2838    return segaddr;
2839 }
2840 #endif
2841
2842 static int
2843 ocVerifyImage_ELF ( ObjectCode* oc )
2844 {
2845    Elf_Shdr* shdr;
2846    Elf_Sym*  stab;
2847    int i, j, nent, nstrtab, nsymtabs;
2848    char* sh_strtab;
2849    char* strtab;
2850
2851    char*     ehdrC = (char*)(oc->image);
2852    Elf_Ehdr* ehdr  = (Elf_Ehdr*)ehdrC;
2853
2854    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2855        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2856        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2857        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2858       errorBelch("%s: not an ELF object", oc->fileName);
2859       return 0;
2860    }
2861
2862    if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2863       errorBelch("%s: unsupported ELF format", oc->fileName);
2864       return 0;
2865    }
2866
2867    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2868        IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2869    } else
2870    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2871        IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2872    } else {
2873        errorBelch("%s: unknown endiannness", oc->fileName);
2874        return 0;
2875    }
2876
2877    if (ehdr->e_type != ET_REL) {
2878       errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2879       return 0;
2880    }
2881    IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2882
2883    IF_DEBUG(linker,debugBelch( "Architecture is " ));
2884    switch (ehdr->e_machine) {
2885       case EM_386:   IF_DEBUG(linker,debugBelch( "x86" )); break;
2886 #ifdef EM_SPARC32PLUS
2887       case EM_SPARC32PLUS:
2888 #endif
2889       case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2890 #ifdef EM_IA_64
2891       case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2892 #endif
2893       case EM_PPC:   IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2894 #ifdef EM_X86_64
2895       case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2896 #elif defined(EM_AMD64)
2897       case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
2898 #endif
2899       default:       IF_DEBUG(linker,debugBelch( "unknown" ));
2900                      errorBelch("%s: unknown architecture (e_machine == %d)"
2901                                 , oc->fileName, ehdr->e_machine);
2902                      return 0;
2903    }
2904
2905    IF_DEBUG(linker,debugBelch(
2906              "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
2907              (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
2908
2909    ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2910
2911    shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2912
2913    if (ehdr->e_shstrndx == SHN_UNDEF) {
2914       errorBelch("%s: no section header string table", oc->fileName);
2915       return 0;
2916    } else {
2917       IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2918                           ehdr->e_shstrndx));
2919       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2920    }
2921
2922    for (i = 0; i < ehdr->e_shnum; i++) {
2923       IF_DEBUG(linker,debugBelch("%2d:  ", i ));
2924       IF_DEBUG(linker,debugBelch("type=%2d  ", (int)shdr[i].sh_type ));
2925       IF_DEBUG(linker,debugBelch("size=%4d  ", (int)shdr[i].sh_size ));
2926       IF_DEBUG(linker,debugBelch("offs=%4d  ", (int)shdr[i].sh_offset ));
2927       IF_DEBUG(linker,debugBelch("  (%p .. %p)  ",
2928                ehdrC + shdr[i].sh_offset,
2929                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2930
2931       if (shdr[i].sh_type == SHT_REL) {
2932           IF_DEBUG(linker,debugBelch("Rel  " ));
2933       } else if (shdr[i].sh_type == SHT_RELA) {
2934           IF_DEBUG(linker,debugBelch("RelA " ));
2935       } else {
2936           IF_DEBUG(linker,debugBelch("     "));
2937       }
2938       if (sh_strtab) {
2939           IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2940       }
2941    }
2942
2943    IF_DEBUG(linker,debugBelch( "\nString tables" ));
2944    strtab = NULL;
2945    nstrtab = 0;
2946    for (i = 0; i < ehdr->e_shnum; i++) {
2947       if (shdr[i].sh_type == SHT_STRTAB
2948           /* Ignore the section header's string table. */
2949           && i != ehdr->e_shstrndx
2950           /* Ignore string tables named .stabstr, as they contain
2951              debugging info. */
2952           && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2953          ) {
2954          IF_DEBUG(linker,debugBelch("   section %d is a normal string table", i ));
2955          strtab = ehdrC + shdr[i].sh_offset;
2956          nstrtab++;
2957       }
2958    }
2959    if (nstrtab != 1) {
2960       errorBelch("%s: no string tables, or too many", oc->fileName);
2961       return 0;
2962    }
2963
2964    nsymtabs = 0;
2965    IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2966    for (i = 0; i < ehdr->e_shnum; i++) {
2967       if (shdr[i].sh_type != SHT_SYMTAB) continue;
2968       IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2969       nsymtabs++;
2970       stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2971       nent = shdr[i].sh_size / sizeof(Elf_Sym);
2972       IF_DEBUG(linker,debugBelch( "   number of entries is apparently %d (%ld rem)\n",
2973                nent,
2974                (long)shdr[i].sh_size % sizeof(Elf_Sym)
2975              ));
2976       if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2977          errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2978          return 0;
2979       }
2980       for (j = 0; j < nent; j++) {
2981          IF_DEBUG(linker,debugBelch("   %2d  ", j ));
2982          IF_DEBUG(linker,debugBelch("  sec=%-5d  size=%-3d  val=%5p  ",
2983                              (int)stab[j].st_shndx,
2984                              (int)stab[j].st_size,
2985                              (char*)stab[j].st_value ));
2986
2987          IF_DEBUG(linker,debugBelch("type=" ));
2988          switch (ELF_ST_TYPE(stab[j].st_info)) {
2989             case STT_NOTYPE:  IF_DEBUG(linker,debugBelch("notype " )); break;
2990             case STT_OBJECT:  IF_DEBUG(linker,debugBelch("object " )); break;
2991             case STT_FUNC  :  IF_DEBUG(linker,debugBelch("func   " )); break;
2992             case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2993             case STT_FILE:    IF_DEBUG(linker,debugBelch("file   " )); break;
2994             default:          IF_DEBUG(linker,debugBelch("?      " )); break;
2995          }
2996          IF_DEBUG(linker,debugBelch("  " ));
2997
2998          IF_DEBUG(linker,debugBelch("bind=" ));
2999          switch (ELF_ST_BIND(stab[j].st_info)) {
3000             case STB_LOCAL :  IF_DEBUG(linker,debugBelch("local " )); break;
3001             case STB_GLOBAL:  IF_DEBUG(linker,debugBelch("global" )); break;
3002             case STB_WEAK  :  IF_DEBUG(linker,debugBelch("weak  " )); break;
3003             default:          IF_DEBUG(linker,debugBelch("?     " )); break;
3004          }
3005          IF_DEBUG(linker,debugBelch("  " ));
3006
3007          IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
3008       }
3009    }
3010
3011    if (nsymtabs == 0) {
3012       errorBelch("%s: didn't find any symbol tables", oc->fileName);
3013       return 0;
3014    }
3015
3016    return 1;
3017 }
3018
3019 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3020 {
3021     *is_bss = FALSE;
3022
3023     if (hdr->sh_type == SHT_PROGBITS
3024         && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3025         /* .text-style section */
3026         return SECTIONKIND_CODE_OR_RODATA;
3027     }
3028
3029     if (hdr->sh_type == SHT_PROGBITS
3030             && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3031             /* .data-style section */
3032             return SECTIONKIND_RWDATA;
3033     }
3034
3035     if (hdr->sh_type == SHT_PROGBITS
3036         && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3037         /* .rodata-style section */
3038         return SECTIONKIND_CODE_OR_RODATA;
3039     }
3040
3041     if (hdr->sh_type == SHT_NOBITS
3042         && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3043         /* .bss-style section */
3044         *is_bss = TRUE;
3045         return SECTIONKIND_RWDATA;
3046     }
3047
3048     return SECTIONKIND_OTHER;
3049 }
3050
3051
3052 static int
3053 ocGetNames_ELF ( ObjectCode* oc )
3054 {
3055    int i, j, k, nent;
3056    Elf_Sym* stab;
3057
3058    char*     ehdrC    = (char*)(oc->image);
3059    Elf_Ehdr* ehdr     = (Elf_Ehdr*)ehdrC;
3060    char*     strtab   = findElfSection ( ehdrC, SHT_STRTAB );
3061    Elf_Shdr* shdr     = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3062
3063    ASSERT(symhash != NULL);
3064
3065    if (!strtab) {
3066       errorBelch("%s: no strtab", oc->fileName);
3067       return 0;
3068    }
3069
3070    k = 0;
3071    for (i = 0; i < ehdr->e_shnum; i++) {
3072       /* Figure out what kind of section it is.  Logic derived from
3073          Figure 1.14 ("Special Sections") of the ELF document
3074          ("Portable Formats Specification, Version 1.1"). */
3075       int         is_bss = FALSE;
3076       SectionKind kind   = getSectionKind_ELF(&shdr[i], &is_bss);
3077
3078       if (is_bss && shdr[i].sh_size > 0) {
3079          /* This is a non-empty .bss section.  Allocate zeroed space for
3080             it, and set its .sh_offset field such that
3081             ehdrC + .sh_offset == addr_of_zeroed_space.  */
3082          char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3083                                        "ocGetNames_ELF(BSS)");
3084          shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3085          /*
3086          debugBelch("BSS section at 0x%x, size %d\n",
3087                          zspace, shdr[i].sh_size);
3088          */
3089       }
3090
3091       /* fill in the section info */
3092       if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3093          addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3094          addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3095                         ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3096       }
3097
3098       if (shdr[i].sh_type != SHT_SYMTAB) continue;
3099
3100       /* copy stuff into this module's object symbol table */
3101       stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3102       nent = shdr[i].sh_size / sizeof(Elf_Sym);
3103
3104       oc->n_symbols = nent;
3105       oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3106                                    "ocGetNames_ELF(oc->symbols)");
3107
3108       for (j = 0; j < nent; j++) {
3109
3110          char  isLocal = FALSE; /* avoids uninit-var warning */
3111          char* ad      = NULL;
3112          char* nm      = strtab + stab[j].st_name;
3113          int   secno   = stab[j].st_shndx;
3114
3115          /* Figure out if we want to add it; if so, set ad to its
3116             address.  Otherwise leave ad == NULL. */
3117
3118          if (secno == SHN_COMMON) {
3119             isLocal = FALSE;
3120             ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3121             /*
3122             debugBelch("COMMON symbol, size %d name %s\n",
3123                             stab[j].st_size, nm);
3124             */
3125             /* Pointless to do addProddableBlock() for this area,
3126                since the linker should never poke around in it. */
3127          }
3128          else
3129          if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3130                 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3131               )
3132               /* and not an undefined symbol */
3133               && stab[j].st_shndx != SHN_UNDEF
3134               /* and not in a "special section" */
3135               && stab[j].st_shndx < SHN_LORESERVE
3136               &&
3137               /* and it's a not a section or string table or anything silly */
3138               ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3139                 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3140                 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3141               )
3142             ) {
3143             /* Section 0 is the undefined section, hence > and not >=. */
3144             ASSERT(secno > 0 && secno < ehdr->e_shnum);
3145             /*
3146             if (shdr[secno].sh_type == SHT_NOBITS) {
3147                debugBelch("   BSS symbol, size %d off %d name %s\n",
3148                                stab[j].st_size, stab[j].st_value, nm);
3149             }
3150             */
3151             ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3152             if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3153                isLocal = TRUE;
3154             } else {
3155 #ifdef ELF_FUNCTION_DESC
3156                /* dlsym() and the initialisation table both give us function
3157                 * descriptors, so to be consistent we store function descriptors
3158                 * in the symbol table */
3159                if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3160                    ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3161 #endif
3162                IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p  %s %s\n",
3163                                       ad, oc->fileName, nm ));
3164                isLocal = FALSE;
3165             }
3166          }
3167
3168          /* And the decision is ... */
3169
3170          if (ad != NULL) {
3171             ASSERT(nm != NULL);
3172             oc->symbols[j] = nm;
3173             /* Acquire! */
3174             if (isLocal) {
3175                /* Ignore entirely. */
3176             } else {
3177                ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3178             }
3179          } else {
3180             /* Skip. */
3181             IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3182                                    strtab + stab[j].st_name ));
3183             /*
3184             debugBelch(
3185                     "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
3186                     (int)ELF_ST_BIND(stab[j].st_info),
3187                     (int)ELF_ST_TYPE(stab[j].st_info),
3188                     (int)stab[j].st_shndx,
3189                     strtab + stab[j].st_name
3190                    );
3191             */
3192             oc->symbols[j] = NULL;
3193          }
3194
3195       }
3196    }
3197
3198    return 1;
3199 }
3200
3201 /* Do ELF relocations which lack an explicit addend.  All x86-linux
3202    relocations appear to be of this form. */
3203 static int
3204 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3205                          Elf_Shdr* shdr, int shnum,
3206                          Elf_Sym*  stab, char* strtab )
3207 {
3208    int j;
3209    char *symbol;
3210    Elf_Word* targ;
3211    Elf_Rel*  rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3212    int         nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3213    int target_shndx = shdr[shnum].sh_info;
3214    int symtab_shndx = shdr[shnum].sh_link;
3215
3216    stab  = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3217    targ  = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3218    IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3219                           target_shndx, symtab_shndx ));
3220
3221    /* Skip sections that we're not interested in. */
3222    {
3223        int is_bss;
3224        SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3225        if (kind == SECTIONKIND_OTHER) {
3226            IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3227            return 1;
3228        }
3229    }
3230
3231    for (j = 0; j < nent; j++) {
3232       Elf_Addr offset = rtab[j].r_offset;
3233       Elf_Addr info   = rtab[j].r_info;
3234
3235       Elf_Addr  P  = ((Elf_Addr)targ) + offset;
3236       Elf_Word* pP = (Elf_Word*)P;
3237       Elf_Addr  A  = *pP;
3238       Elf_Addr  S;
3239       void*     S_tmp;
3240       Elf_Addr  value;
3241       StgStablePtr stablePtr;
3242       StgPtr stableVal;
3243
3244       IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3245                              j, (void*)offset, (void*)info ));
3246       if (!info) {
3247          IF_DEBUG(linker,debugBelch( " ZERO" ));
3248          S = 0;
3249       } else {
3250          Elf_Sym sym = stab[ELF_R_SYM(info)];
3251          /* First see if it is a local symbol. */
3252          if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3253             /* Yes, so we can get the address directly from the ELF symbol
3254                table. */
3255             symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3256             S = (Elf_Addr)
3257                 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3258                        + stab[ELF_R_SYM(info)].st_value);
3259
3260          } else {
3261             symbol = strtab + sym.st_name;
3262             stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
3263             if (NULL == stablePtr) {
3264               /* No, so look up the name in our global table. */
3265               S_tmp = lookupSymbol( symbol );
3266               S = (Elf_Addr)S_tmp;
3267             } else {
3268               stableVal = deRefStablePtr( stablePtr );
3269               S_tmp = stableVal;
3270               S = (Elf_Addr)S_tmp;
3271             }
3272          }
3273          if (!S) {
3274             errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3275             return 0;
3276          }
3277          IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3278       }
3279
3280       IF_DEBUG(linker,debugBelch( "Reloc: P = %p   S = %p   A = %p\n",
3281                              (void*)P, (void*)S, (void*)A ));
3282       checkProddableBlock ( oc, pP );
3283
3284       value = S + A;
3285
3286       switch (ELF_R_TYPE(info)) {
3287 #        ifdef i386_HOST_ARCH
3288          case R_386_32:   *pP = value;     break;
3289          case R_386_PC32: *pP = value - P; break;
3290 #        endif
3291          default:
3292             errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3293                   oc->fileName, (lnat)ELF_R_TYPE(info));
3294             return 0;
3295       }
3296
3297    }
3298    return 1;
3299 }
3300
3301 /* Do ELF relocations for which explicit addends are supplied.
3302    sparc-solaris relocations appear to be of this form. */
3303 static int
3304 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3305                           Elf_Shdr* shdr, int shnum,
3306                           Elf_Sym*  stab, char* strtab )
3307 {
3308    int j;
3309    char *symbol = NULL;
3310    Elf_Addr targ;
3311    Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3312    int         nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3313    int target_shndx = shdr[shnum].sh_info;
3314    int symtab_shndx = shdr[shnum].sh_link;
3315
3316    stab  = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3317    targ  = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3318    IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3319                           target_shndx, symtab_shndx ));
3320
3321    for (j = 0; j < nent; j++) {
3322 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3323       /* This #ifdef only serves to avoid unused-var warnings. */
3324       Elf_Addr  offset = rtab[j].r_offset;
3325       Elf_Addr  P      = targ + offset;
3326 #endif
3327       Elf_Addr  info   = rtab[j].r_info;
3328       Elf_Addr  A      = rtab[j].r_addend;
3329       Elf_Addr  S;
3330       void*     S_tmp;
3331       Elf_Addr  value;
3332 #     if defined(sparc_HOST_ARCH)
3333       Elf_Word* pP = (Elf_Word*)P;
3334       Elf_Word  w1, w2;
3335 #     elif defined(ia64_HOST_ARCH)
3336       Elf64_Xword *pP = (Elf64_Xword *)P;
3337       Elf_Addr addr;
3338 #     elif defined(powerpc_HOST_ARCH)
3339       Elf_Sword delta;
3340 #     endif
3341
3342       IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p)   ",
3343                              j, (void*)offset, (void*)info,
3344                                 (void*)A ));
3345       if (!info) {
3346          IF_DEBUG(linker,debugBelch( " ZERO" ));
3347          S = 0;
3348       } else {
3349          Elf_Sym sym = stab[ELF_R_SYM(info)];
3350          /* First see if it is a local symbol. */
3351          if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3352             /* Yes, so we can get the address directly from the ELF symbol
3353                table. */
3354             symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3355             S = (Elf_Addr)
3356                 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3357                        + stab[ELF_R_SYM(info)].st_value);
3358 #ifdef ELF_FUNCTION_DESC
3359             /* Make a function descriptor for this function */
3360             if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3361                S = allocateFunctionDesc(S + A);
3362                A = 0;
3363             }
3364 #endif
3365          } else {
3366             /* No, so look up the name in our global table. */
3367             symbol = strtab + sym.st_name;
3368             S_tmp = lookupSymbol( symbol );
3369             S = (Elf_Addr)S_tmp;
3370
3371 #ifdef ELF_FUNCTION_DESC
3372             /* If a function, already a function descriptor - we would
3373                have to copy it to add an offset. */
3374             if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3375                errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3376 #endif
3377          }
3378          if (!S) {
3379            errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3380            return 0;
3381          }
3382          IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3383       }
3384
3385       IF_DEBUG(linker,debugBelch("Reloc: P = %p   S = %p   A = %p\n",
3386                                         (void*)P, (void*)S, (void*)A ));
3387       /* checkProddableBlock ( oc, (void*)P ); */
3388
3389       value = S + A;
3390
3391       switch (ELF_R_TYPE(info)) {
3392 #        if defined(sparc_HOST_ARCH)
3393          case R_SPARC_WDISP30:
3394             w1 = *pP & 0xC0000000;
3395             w2 = (Elf_Word)((value - P) >> 2);
3396             ASSERT((w2 & 0xC0000000) == 0);
3397             w1 |= w2;
3398             *pP = w1;
3399             break;
3400          case R_SPARC_HI22:
3401             w1 = *pP & 0xFFC00000;
3402             w2 = (Elf_Word)(value >> 10);
3403             ASSERT((w2 & 0xFFC00000) == 0);
3404             w1 |= w2;
3405             *pP = w1;
3406             break;
3407          case R_SPARC_LO10:
3408             w1 = *pP & ~0x3FF;
3409             w2 = (Elf_Word)(value & 0x3FF);
3410             ASSERT((w2 & ~0x3FF) == 0);
3411             w1 |= w2;
3412             *pP = w1;
3413             break;
3414          /* According to the Sun documentation:
3415             R_SPARC_UA32
3416             This relocation type resembles R_SPARC_32, except it refers to an
3417             unaligned word. That is, the word to be relocated must be treated
3418             as four separate bytes with arbitrary alignment, not as a word
3419             aligned according to the architecture requirements.
3420
3421             (JRS: which means that freeloading on the R_SPARC_32 case
3422             is probably wrong, but hey ...)
3423          */
3424          case R_SPARC_UA32:
3425          case R_SPARC_32:
3426             w2 = (Elf_Word)value;
3427             *pP = w2;
3428             break;
3429 #        elif defined(ia64_HOST_ARCH)
3430          case R_IA64_DIR64LSB:
3431          case R_IA64_FPTR64LSB:
3432             *pP = value;
3433             break;
3434          case R_IA64_PCREL64LSB:
3435             *pP = value - P;
3436             break;
3437          case R_IA64_SEGREL64LSB:
3438             addr = findElfSegment(ehdrC, value);
3439             *pP = value - addr;
3440             break;
3441          case R_IA64_GPREL22:
3442             ia64_reloc_gprel22(P, value);
3443             break;
3444          case R_IA64_LTOFF22:
3445          case R_IA64_LTOFF22X:
3446          case R_IA64_LTOFF_FPTR22:
3447             addr = allocateGOTEntry(value);
3448             ia64_reloc_gprel22(P, addr);
3449             break;
3450          case R_IA64_PCREL21B:
3451             ia64_reloc_pcrel21(P, S, oc);
3452             break;
3453          case R_IA64_LDXMOV:
3454             /* This goes with R_IA64_LTOFF22X and points to the load to
3455              * convert into a move.  We don't implement relaxation. */
3456             break;
3457 #        elif defined(powerpc_HOST_ARCH)
3458          case R_PPC_ADDR16_LO:
3459             *(Elf32_Half*) P = value;
3460             break;
3461
3462          case R_PPC_ADDR16_HI:
3463             *(Elf32_Half*) P = value >> 16;
3464             break;
3465
3466          case R_PPC_ADDR16_HA:
3467             *(Elf32_Half*) P = (value + 0x8000) >> 16;
3468             break;
3469
3470          case R_PPC_ADDR32:
3471             *(Elf32_Word *) P = value;
3472             break;
3473
3474          case R_PPC_REL32:
3475             *(Elf32_Word *) P = value - P;
3476             break;
3477
3478          case R_PPC_REL24:
3479             delta = value - P;
3480
3481             if( delta << 6 >> 6 != delta )
3482             {
3483                value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
3484                                         ->jumpIsland);
3485                delta = value - P;
3486
3487                if( value == 0 || delta << 6 >> 6 != delta )
3488                {
3489                   barf( "Unable to make SymbolExtra for #%d",
3490                         ELF_R_SYM(info) );
3491                   return 0;
3492                }
3493             }
3494
3495             *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3496                                           | (delta & 0x3fffffc);
3497             break;
3498 #        endif
3499
3500 #if x86_64_HOST_ARCH
3501       case R_X86_64_64:
3502           *(Elf64_Xword *)P = value;
3503           break;
3504
3505       case R_X86_64_PC32:
3506       {
3507           StgInt64 off = value - P;
3508           if (off >= 0x7fffffffL || off < -0x80000000L) {
3509 #if X86_64_ELF_NONPIC_HACK
3510               StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3511                                                 -> jumpIsland;
3512               off = pltAddress + A - P;
3513 #else
3514               barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3515                    symbol, off, oc->fileName );
3516 #endif
3517           }
3518           *(Elf64_Word *)P = (Elf64_Word)off;
3519           break;
3520       }
3521
3522       case R_X86_64_PC64:
3523       {
3524           StgInt64 off = value - P;
3525           *(Elf64_Word *)P = (Elf64_Word)off;
3526           break;
3527       }
3528
3529       case R_X86_64_32:
3530           if (value >= 0x7fffffffL) {
3531 #if X86_64_ELF_NONPIC_HACK
3532               StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3533                                                 -> jumpIsland;
3534               value = pltAddress + A;
3535 #else
3536               barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3537                    symbol, value, oc->fileName );
3538 #endif
3539           }
3540           *(Elf64_Word *)P = (Elf64_Word)value;
3541           break;
3542
3543       case R_X86_64_32S:
3544           if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3545 #if X86_64_ELF_NONPIC_HACK
3546               StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3547                                                 -> jumpIsland;
3548               value = pltAddress + A;
3549 #else
3550               barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3551                    symbol, value, oc->fileName );
3552 #endif
3553           }
3554           *(Elf64_Sword *)P = (Elf64_Sword)value;
3555           break;
3556
3557       case R_X86_64_GOTPCREL:
3558       {
3559           StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
3560           StgInt64 off = gotAddress + A - P;
3561           *(Elf64_Word *)P = (Elf64_Word)off;
3562           break;
3563       }
3564
3565       case R_X86_64_PLT32:
3566       {
3567           StgInt64 off = value - P;
3568           if (off >= 0x7fffffffL || off < -0x80000000L) {
3569               StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3570                                                     -> jumpIsland;
3571               off = pltAddress + A - P;
3572           }
3573           *(Elf64_Word *)P = (Elf64_Word)off;
3574           break;
3575       }
3576 #endif
3577
3578          default:
3579             errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
3580                   oc->fileName, (lnat)ELF_R_TYPE(info));
3581             return 0;
3582       }
3583
3584    }
3585    return 1;
3586 }
3587
3588 static int
3589 ocResolve_ELF ( ObjectCode* oc )
3590 {
3591    char *strtab;
3592    int   shnum, ok;
3593    Elf_Sym*  stab  = NULL;
3594    char*     ehdrC = (char*)(oc->image);
3595    Elf_Ehdr* ehdr  = (Elf_Ehdr*) ehdrC;
3596    Elf_Shdr* shdr  = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3597
3598    /* first find "the" symbol table */
3599    stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3600
3601    /* also go find the string table */
3602    strtab = findElfSection ( ehdrC, SHT_STRTAB );
3603
3604    if (stab == NULL || strtab == NULL) {
3605       errorBelch("%s: can't find string or symbol table", oc->fileName);
3606       return 0;
3607    }
3608
3609    /* Process the relocation sections. */
3610    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3611       if (shdr[shnum].sh_type == SHT_REL) {
3612          ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3613                                        shnum, stab, strtab );
3614          if (!ok) return ok;
3615       }
3616       else
3617       if (shdr[shnum].sh_type == SHT_RELA) {
3618          ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3619                                         shnum, stab, strtab );
3620          if (!ok) return ok;
3621       }
3622    }
3623
3624 #if defined(powerpc_HOST_ARCH)
3625    ocFlushInstructionCache( oc );
3626 #endif
3627
3628    return 1;
3629 }
3630
3631 /*
3632  * IA64 specifics
3633  * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3634  * at the front.  The following utility functions pack and unpack instructions, and
3635  * take care of the most common relocations.
3636  */
3637
3638 #ifdef ia64_HOST_ARCH
3639
3640 static Elf64_Xword
3641 ia64_extract_instruction(Elf64_Xword *target)
3642 {
3643    Elf64_Xword w1, w2;
3644    int slot = (Elf_Addr)target & 3;
3645    target = (Elf_Addr)target & ~3;
3646
3647    w1 = *target;
3648    w2 = *(target+1);
3649
3650    switch (slot)
3651    {
3652       case 0:
3653          return ((w1 >> 5) & 0x1ffffffffff);
3654       case 1:
3655          return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3656       case 2:
3657          return (w2 >> 23);
3658       default:
3659          barf("ia64_extract_instruction: invalid slot %p", target);
3660    }
3661 }
3662
3663 static void
3664 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3665 {
3666    int slot = (Elf_Addr)target & 3;
3667    target = (Elf_Addr)target & ~3;
3668
3669    switch (slot)
3670    {
3671       case 0:
3672          *target |= value << 5;
3673          break;
3674       case 1:
3675          *target |= value << 46;
3676          *(target+1) |= value >> 18;
3677          break;
3678       case 2:
3679          *(target+1) |= value << 23;
3680          break;
3681    }
3682 }
3683
3684 static void
3685 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3686 {
3687    Elf64_Xword instruction;
3688    Elf64_Sxword rel_value;
3689
3690    rel_value = value - gp_val;
3691    if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3692       barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3693
3694    instruction = ia64_extract_instruction((Elf64_Xword *)target);
3695    instruction |= (((rel_value >> 0) & 0x07f) << 13)            /* imm7b */
3696                     | (((rel_value >> 7) & 0x1ff) << 27)        /* imm9d */
3697                     | (((rel_value >> 16) & 0x01f) << 22)       /* imm5c */
3698                     | ((Elf64_Xword)(rel_value < 0) << 36);     /* s */
3699    ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3700 }
3701
3702 static void
3703 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3704 {
3705    Elf64_Xword instruction;
3706    Elf64_Sxword rel_value;
3707    Elf_Addr entry;
3708
3709    entry = allocatePLTEntry(value, oc);
3710
3711    rel_value = (entry >> 4) - (target >> 4);
3712    if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3713       barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3714
3715    instruction = ia64_extract_instruction((Elf64_Xword *)target);
3716    instruction |= ((rel_value & 0xfffff) << 13)                 /* imm20b */
3717                     | ((Elf64_Xword)(rel_value < 0) << 36);     /* s */
3718    ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3719 }
3720
3721 #endif /* ia64 */
3722
3723 /*
3724  * PowerPC & X86_64 ELF specifics
3725  */
3726
3727 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3728
3729 static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
3730 {
3731   Elf_Ehdr *ehdr;
3732   Elf_Shdr* shdr;
3733   int i;
3734
3735   ehdr = (Elf_Ehdr *) oc->image;
3736   shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3737
3738   for( i = 0; i < ehdr->e_shnum; i++ )
3739     if( shdr[i].sh_type == SHT_SYMTAB )
3740       break;
3741
3742   if( i == ehdr->e_shnum )
3743   {
3744     errorBelch( "This ELF file contains no symtab" );
3745     return 0;
3746   }
3747
3748   if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3749   {
3750     errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3751       (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
3752
3753     return 0;
3754   }
3755
3756   return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3757 }
3758
3759 #endif /* powerpc */
3760
3761 #endif /* ELF */
3762
3763 /* --------------------------------------------------------------------------
3764  * Mach-O specifics
3765  * ------------------------------------------------------------------------*/
3766
3767 #if defined(OBJFORMAT_MACHO)
3768
3769 /*
3770   Support for MachO linking on Darwin/MacOS X
3771   by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3772
3773   I hereby formally apologize for the hackish nature of this code.
3774   Things that need to be done:
3775   *) implement ocVerifyImage_MachO
3776   *) add still more sanity checks.
3777 */
3778
3779 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
3780 #define mach_header mach_header_64
3781 #define segment_command segment_command_64
3782 #define section section_64
3783 #define nlist nlist_64
3784 #endif
3785
3786 #ifdef powerpc_HOST_ARCH
3787 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3788 {
3789     struct mach_header *header = (struct mach_header *) oc->image;
3790     struct load_command *lc = (struct load_command *) (header + 1);
3791     unsigned i;
3792
3793     for( i = 0; i < header->ncmds; i++ )
3794     {
3795         if( lc->cmd == LC_SYMTAB )
3796         {
3797                 // Find out the first and last undefined external
3798                 // symbol, so we don't have to allocate too many
3799                 // jump islands.
3800             struct symtab_command *symLC = (struct symtab_command *) lc;
3801             unsigned min = symLC->nsyms, max = 0;
3802             struct nlist *nlist =
3803                 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3804                       : NULL;
3805             for(i=0;i<symLC->nsyms;i++)
3806             {
3807                 if(nlist[i].n_type & N_STAB)
3808                     ;
3809                 else if(nlist[i].n_type & N_EXT)
3810                 {
3811                     if((nlist[i].n_type & N_TYPE) == N_UNDF
3812                         && (nlist[i].n_value == 0))
3813                     {
3814                         if(i < min)
3815                             min = i;
3816                         if(i > max)
3817                             max = i;
3818                     }
3819                 }
3820             }
3821             if(max >= min)
3822                 return ocAllocateSymbolExtras(oc, max - min + 1, min);
3823
3824             break;
3825         }
3826
3827         lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3828     }
3829     return ocAllocateSymbolExtras(oc,0,0);
3830 }
3831 #endif
3832 #ifdef x86_64_HOST_ARCH
3833 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3834 {
3835     struct mach_header *header = (struct mach_header *) oc->image;
3836     struct load_command *lc = (struct load_command *) (header + 1);
3837     unsigned i;
3838
3839     for( i = 0; i < header->ncmds; i++ )
3840     {
3841         if( lc->cmd == LC_SYMTAB )
3842         {
3843                 // Just allocate one entry for every symbol
3844             struct symtab_command *symLC = (struct symtab_command *) lc;
3845
3846             return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
3847         }
3848
3849         lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3850     }
3851     return ocAllocateSymbolExtras(oc,0,0);
3852 }
3853 #endif
3854
3855 static int ocVerifyImage_MachO(ObjectCode* oc)
3856 {
3857     char *image = (char*) oc->image;
3858     struct mach_header *header = (struct mach_header*) image;
3859
3860 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
3861     if(header->magic != MH_MAGIC_64)
3862         return 0;
3863 #else
3864     if(header->magic != MH_MAGIC)
3865         return 0;
3866 #endif
3867     // FIXME: do some more verifying here
3868     return 1;
3869 }
3870
3871 static int resolveImports(
3872     ObjectCode* oc,
3873     char *image,
3874     struct symtab_command *symLC,
3875     struct section *sect,    // ptr to lazy or non-lazy symbol pointer section
3876     unsigned long *indirectSyms,
3877     struct nlist *nlist)
3878 {
3879     unsigned i;
3880     size_t itemSize = 4;
3881
3882 #if i386_HOST_ARCH
3883     int isJumpTable = 0;
3884     if(!strcmp(sect->sectname,"__jump_table"))
3885     {
3886         isJumpTable = 1;
3887         itemSize = 5;
3888         ASSERT(sect->reserved2 == itemSize);
3889     }
3890 #endif
3891
3892     for(i=0; i*itemSize < sect->size;i++)
3893     {
3894         // according to otool, reserved1 contains the first index into the indirect symbol table
3895         struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3896         char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3897         void *addr = NULL;
3898
3899         if((symbol->n_type & N_TYPE) == N_UNDF
3900             && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3901             addr = (void*) (symbol->n_value);
3902         else
3903             addr = lookupSymbol(nm);
3904         if(!addr)
3905         {
3906             errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3907             return 0;
3908         }
3909         ASSERT(addr);
3910
3911 #if i386_HOST_ARCH
3912         if(isJumpTable)
3913         {
3914             checkProddableBlock(oc,image + sect->offset + i*itemSize);
3915             *(image + sect->offset + i*itemSize) = 0xe9; // jmp
3916             *(unsigned*)(image + sect->offset + i*itemSize + 1)
3917                 = (char*)addr - (image + sect->offset + i*itemSize + 5);
3918         }
3919         else
3920 #endif
3921         {
3922             checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3923             ((void**)(image + sect->offset))[i] = addr;
3924         }
3925     }
3926
3927     return 1;
3928 }
3929
3930 static unsigned long relocateAddress(
3931     ObjectCode* oc,
3932     int nSections,
3933     struct section* sections,
3934     unsigned long address)
3935 {
3936     int i;
3937     for(i = 0; i < nSections; i++)
3938     {
3939         if(sections[i].addr <= address
3940             && address < sections[i].addr + sections[i].size)
3941         {
3942             return (unsigned long)oc->image
3943                     + sections[i].offset + address - sections[i].addr;
3944         }
3945     }
3946     barf("Invalid Mach-O file:"
3947          "Address out of bounds while relocating object file");
3948     return 0;
3949 }
3950
3951 static int relocateSection(
3952     ObjectCode* oc,
3953     char *image,
3954     struct symtab_command *symLC, struct nlist *nlist,
3955     int nSections, struct section* sections, struct section *sect)
3956 {
3957     struct relocation_info *relocs;
3958     int i,n;
3959
3960     if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3961         return 1;
3962     else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3963         return 1;
3964     else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
3965         return 1;
3966     else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
3967         return 1;
3968
3969     n = sect->nreloc;
3970     relocs = (struct relocation_info*) (image + sect->reloff);
3971
3972     for(i=0;i<n;i++)
3973     {
3974 #ifdef x86_64_HOST_ARCH
3975         struct relocation_info *reloc = &relocs[i];
3976
3977         char    *thingPtr = image + sect->offset + reloc->r_address;
3978         uint64_t thing;
3979         uint64_t value;
3980         uint64_t baseValue;
3981         int type = reloc->r_type;
3982
3983         checkProddableBlock(oc,thingPtr);
3984         switch(reloc->r_length)
3985         {
3986             case 0:
3987                 thing = *(uint8_t*)thingPtr;
3988                 baseValue = (uint64_t)thingPtr + 1;
3989                 break;
3990             case 1:
3991                 thing = *(uint16_t*)thingPtr;
3992                 baseValue = (uint64_t)thingPtr + 2;
3993                 break;
3994             case 2:
3995                 thing = *(uint32_t*)thingPtr;
3996                 baseValue = (uint64_t)thingPtr + 4;
3997                 break;
3998             case 3:
3999                 thing = *(uint64_t*)thingPtr;
4000                 baseValue = (uint64_t)thingPtr + 8;
4001                 break;
4002             default:
4003                 barf("Unknown size.");
4004         }
4005
4006         if(type == X86_64_RELOC_GOT
4007            || type == X86_64_RELOC_GOT_LOAD)
4008         {
4009             ASSERT(reloc->r_extern);
4010             value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
4011
4012             type = X86_64_RELOC_SIGNED;
4013         }
4014         else if(reloc->r_extern)
4015         {
4016             struct nlist *symbol = &nlist[reloc->r_symbolnum];
4017             char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4018             if(symbol->n_value == 0)
4019                 value = (uint64_t) lookupSymbol(nm);
4020             else
4021                 value = relocateAddress(oc, nSections, sections,
4022                                         symbol->n_value);
4023         }
4024         else
4025         {
4026             value = sections[reloc->r_symbolnum-1].offset
4027                   - sections[reloc->r_symbolnum-1].addr
4028                   + (uint64_t) image;
4029         }
4030
4031         if(type == X86_64_RELOC_BRANCH)
4032         {
4033             if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4034             {
4035                 ASSERT(reloc->r_extern);
4036                 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4037                                         -> jumpIsland;
4038             }
4039             ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4040             type = X86_64_RELOC_SIGNED;
4041         }
4042
4043         switch(type)
4044         {
4045             case X86_64_RELOC_UNSIGNED:
4046                 ASSERT(!reloc->r_pcrel);
4047                 thing += value;
4048                 break;
4049             case X86_64_RELOC_SIGNED:
4050                 ASSERT(reloc->r_pcrel);
4051                 thing += value - baseValue;
4052                 break;
4053             case X86_64_RELOC_SUBTRACTOR:
4054                 ASSERT(!reloc->r_pcrel);
4055                 thing -= value;
4056                 break;
4057             default:
4058                 barf("unkown relocation");
4059         }
4060
4061         switch(reloc->r_length)
4062         {
4063             case 0:
4064                 *(uint8_t*)thingPtr = thing;
4065                 break;
4066             case 1:
4067                 *(uint16_t*)thingPtr = thing;
4068                 break;
4069             case 2:
4070                 *(uint32_t*)thingPtr = thing;
4071                 break;
4072             case 3:
4073                 *(uint64_t*)thingPtr = thing;
4074                 break;
4075         }
4076 #else
4077         if(relocs[i].r_address & R_SCATTERED)
4078         {
4079             struct scattered_relocation_info *scat =
4080                 (struct scattered_relocation_info*) &relocs[i];
4081
4082             if(!scat->r_pcrel)
4083             {
4084                 if(scat->r_length == 2)
4085                 {
4086                     unsigned long word = 0;
4087                     unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4088                     checkProddableBlock(oc,wordPtr);
4089
4090                     // Note on relocation types:
4091                     // i386 uses the GENERIC_RELOC_* types,
4092                     // while ppc uses special PPC_RELOC_* types.
4093                     // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4094                     // in both cases, all others are different.
4095                     // Therefore, we use GENERIC_RELOC_VANILLA
4096                     // and GENERIC_RELOC_PAIR instead of the PPC variants,
4097                     // and use #ifdefs for the other types.
4098
4099                     // Step 1: Figure out what the relocated value should be
4100                     if(scat->r_type == GENERIC_RELOC_VANILLA)
4101                     {
4102                         word = *wordPtr + (unsigned long) relocateAddress(
4103                                                                 oc,
4104                                                                 nSections,
4105                                                                 sections,
4106                                                                 scat->r_value)
4107                                         - scat->r_value;
4108                     }
4109 #ifdef powerpc_HOST_ARCH
4110                     else if(scat->r_type == PPC_RELOC_SECTDIFF
4111                         || scat->r_type == PPC_RELOC_LO16_SECTDIFF
4112                         || scat->r_type == PPC_RELOC_HI16_SECTDIFF
4113                         || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
4114 #else
4115                     else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
4116 #endif
4117                     {
4118                         struct scattered_relocation_info *pair =
4119                                 (struct scattered_relocation_info*) &relocs[i+1];
4120
4121                         if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
4122                             barf("Invalid Mach-O file: "
4123                                  "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4124
4125                         word = (unsigned long)
4126                                (relocateAddress(oc, nSections, sections, scat->r_value)
4127                               - relocateAddress(oc, nSections, sections, pair->r_value));
4128                         i++;
4129                     }
4130 #ifdef powerpc_HOST_ARCH
4131                     else if(scat->r_type == PPC_RELOC_HI16
4132                          || scat->r_type == PPC_RELOC_LO16
4133                          || scat->r_type == PPC_RELOC_HA16
4134                          || scat->r_type == PPC_RELOC_LO14)
4135                     {   // these are generated by label+offset things
4136                         struct relocation_info *pair = &relocs[i+1];
4137                         if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
4138                             barf("Invalid Mach-O file: "
4139                                  "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
4140
4141                         if(scat->r_type == PPC_RELOC_LO16)
4142                         {
4143                             word = ((unsigned short*) wordPtr)[1];
4144                             word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4145                         }
4146                         else if(scat->r_type == PPC_RELOC_LO14)
4147                         {
4148                             barf("Unsupported Relocation: PPC_RELOC_LO14");
4149                             word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
4150                             word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4151                         }
4152                         else if(scat->r_type == PPC_RELOC_HI16)
4153                         {
4154                             word = ((unsigned short*) wordPtr)[1] << 16;
4155                             word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4156                         }
4157                         else if(scat->r_type == PPC_RELOC_HA16)
4158                         {
4159                             word = ((unsigned short*) wordPtr)[1] << 16;
4160                             word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4161                         }
4162
4163
4164                         word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
4165                                                 - scat->r_value;
4166
4167                         i++;
4168                     }
4169  #endif
4170                     else
4171                         continue;  // ignore the others
4172
4173 #ifdef powerpc_HOST_ARCH
4174                     if(scat->r_type == GENERIC_RELOC_VANILLA
4175                         || scat->r_type == PPC_RELOC_SECTDIFF)
4176 #else
4177                     if(scat->r_type == GENERIC_RELOC_VANILLA
4178                         || scat->r_type == GENERIC_RELOC_SECTDIFF)
4179 #endif
4180                     {
4181                         *wordPtr = word;
4182                     }
4183 #ifdef powerpc_HOST_ARCH
4184                     else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
4185                     {
4186                         ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4187                     }
4188                     else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
4189                     {
4190                         ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4191                     }
4192                     else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
4193                     {
4194                         ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4195                             + ((word & (1<<15)) ? 1 : 0);
4196                     }
4197 #endif
4198                 }
4199             }
4200
4201             continue; // FIXME: I hope it's OK to ignore all the others.
4202         }
4203         else
4204         {
4205             struct relocation_info *reloc = &relocs[i];
4206             if(reloc->r_pcrel && !reloc->r_extern)
4207                 continue;
4208
4209             if(reloc->r_length == 2)
4210             {
4211                 unsigned long word = 0;
4212 #ifdef powerpc_HOST_ARCH
4213                 unsigned long jumpIsland = 0;
4214                 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
4215                                                       // to avoid warning and to catch
4216                                                       // bugs.
4217 #endif
4218
4219                 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
4220                 checkProddableBlock(oc,wordPtr);
4221
4222                 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4223                 {
4224                     word = *wordPtr;
4225                 }
4226 #ifdef powerpc_HOST_ARCH
4227                 else if(reloc->r_type == PPC_RELOC_LO16)
4228                 {
4229                     word = ((unsigned short*) wordPtr)[1];
4230                     word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4231                 }
4232                 else if(reloc->r_type == PPC_RELOC_HI16)
4233                 {
4234                     word = ((unsigned short*) wordPtr)[1] << 16;
4235                     word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4236                 }
4237                 else if(reloc->r_type == PPC_RELOC_HA16)
4238                 {
4239                     word = ((unsigned short*) wordPtr)[1] << 16;
4240                     word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4241                 }
4242                 else if(reloc->r_type == PPC_RELOC_BR24)
4243                 {
4244                     word = *wordPtr;
4245                     word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
4246                 }
4247 #endif
4248
4249                 if(!reloc->r_extern)
4250                 {
4251                     long delta =
4252                         sections[reloc->r_symbolnum-1].offset
4253                         - sections[reloc->r_symbolnum-1].addr
4254                         + ((long) image);
4255
4256                     word += delta;
4257                 }
4258                 else
4259                 {
4260                     struct nlist *symbol = &nlist[reloc->r_symbolnum];
4261                     char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4262                     void *symbolAddress = lookupSymbol(nm);
4263                     if(!symbolAddress)
4264                     {
4265                         errorBelch("\nunknown symbol `%s'", nm);
4266                         return 0;
4267                     }
4268
4269                     if(reloc->r_pcrel)
4270                     {
4271 #ifdef powerpc_HOST_ARCH
4272                             // In the .o file, this should be a relative jump to NULL
4273                             // and we'll change it to a relative jump to the symbol
4274                         ASSERT(word + reloc->r_address == 0);
4275                         jumpIsland = (unsigned long)
4276                                         &makeSymbolExtra(oc,
4277                                                          reloc->r_symbolnum,
4278                                                          (unsigned long) symbolAddress)
4279                                          -> jumpIsland;
4280                         if(jumpIsland != 0)
4281                         {
4282                             offsetToJumpIsland = word + jumpIsland
4283                                 - (((long)image) + sect->offset - sect->addr);
4284                         }
4285 #endif
4286                         word += (unsigned long) symbolAddress
4287                                 - (((long)image) + sect->offset - sect->addr);
4288                     }
4289                     else
4290                     {
4291                         word += (unsigned long) symbolAddress;
4292                     }
4293                 }
4294
4295                 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4296                 {
4297                     *wordPtr = word;
4298                     continue;
4299                 }
4300 #ifdef powerpc_HOST_ARCH
4301                 else if(reloc->r_type == PPC_RELOC_LO16)
4302                 {
4303                     ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4304                     i++; continue;
4305                 }
4306                 else if(reloc->r_type == PPC_RELOC_HI16)
4307                 {
4308                     ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4309                     i++; continue;
4310                 }
4311                 else if(reloc->r_type == PPC_RELOC_HA16)
4312                 {
4313                     ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4314                         + ((word & (1<<15)) ? 1 : 0);
4315                     i++; continue;
4316                 }
4317                 else if(reloc->r_type == PPC_RELOC_BR24)
4318                 {
4319                     if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4320                     {
4321                         // The branch offset is too large.
4322                         // Therefore, we try to use a jump island.
4323                         if(jumpIsland == 0)
4324                         {
4325                             barf("unconditional relative branch out of range: "
4326                                  "no jump island available");
4327                         }
4328
4329                         word = offsetToJumpIsland;
4330                         if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4331                             barf("unconditional relative branch out of range: "
4332                                  "jump island out of range");
4333                     }
4334                     *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
4335                     continue;
4336                 }
4337 #endif
4338             }
4339             barf("\nunknown relocation %d",reloc->r_type);
4340             return 0;
4341         }
4342 #endif
4343     }
4344     return 1;
4345 }
4346
4347 static int ocGetNames_MachO(ObjectCode* oc)
4348 {
4349     char *image = (char*) oc->image;
4350     struct mach_header *header = (struct mach_header*) image;
4351     struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4352     unsigned i,curSymbol = 0;
4353     struct segment_command *segLC = NULL;
4354     struct section *sections;
4355     struct symtab_command *symLC = NULL;
4356     struct nlist *nlist;
4357     unsigned long commonSize = 0;
4358     char    *commonStorage = NULL;
4359     unsigned long commonCounter;
4360
4361     for(i=0;i<header->ncmds;i++)
4362     {
4363         if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4364             segLC = (struct segment_command*) lc;
4365         else if(lc->cmd == LC_SYMTAB)
4366             symLC = (struct symtab_command*) lc;
4367         lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4368     }
4369
4370     sections = (struct section*) (segLC+1);
4371     nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4372                   : NULL;
4373
4374     if(!segLC)
4375         barf("ocGetNames_MachO: no segment load command");
4376
4377     for(i=0;i<segLC->nsects;i++)
4378     {
4379         if(sections[i].size == 0)
4380             continue;
4381
4382         if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4383         {
4384             char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4385                                       "ocGetNames_MachO(common symbols)");
4386             sections[i].offset = zeroFillArea - image;
4387         }
4388
4389         if(!strcmp(sections[i].sectname,"__text"))
4390             addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4391                 (void*) (image + sections[i].offset),
4392                 (void*) (image + sections[i].offset + sections[i].size));
4393         else if(!strcmp(sections[i].sectname,"__const"))
4394             addSection(oc, SECTIONKIND_RWDATA,
4395                 (void*) (image + sections[i].offset),
4396                 (void*) (image + sections[i].offset + sections[i].size));
4397         else if(!strcmp(sections[i].sectname,"__data"))
4398             addSection(oc, SECTIONKIND_RWDATA,
4399                 (void*) (image + sections[i].offset),
4400                 (void*) (image + sections[i].offset + sections[i].size));
4401         else if(!strcmp(sections[i].sectname,"__bss")
4402                 || !strcmp(sections[i].sectname,"__common"))
4403             addSection(oc, SECTIONKIND_RWDATA,
4404                 (void*) (image + sections[i].offset),
4405                 (void*) (image + sections[i].offset + sections[i].size));
4406
4407         addProddableBlock(oc, (void*) (image + sections[i].offset),
4408                                         sections[i].size);
4409     }
4410
4411         // count external symbols defined here
4412     oc->n_symbols = 0;
4413     if(symLC)
4414     {
4415         for(i=0;i<symLC->nsyms;i++)
4416         {
4417             if(nlist[i].n_type & N_STAB)
4418                 ;
4419             else if(nlist[i].n_type & N_EXT)
4420             {
4421                 if((nlist[i].n_type & N_TYPE) == N_UNDF
4422                     && (nlist[i].n_value != 0))
4423                 {
4424                     commonSize += nlist[i].n_value;
4425                     oc->n_symbols++;
4426                 }
4427                 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4428                     oc->n_symbols++;
4429             }
4430         }
4431     }
4432     oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4433                                    "ocGetNames_MachO(oc->symbols)");
4434
4435     if(symLC)
4436     {
4437         for(i=0;i<symLC->nsyms;i++)
4438         {
4439             if(nlist[i].n_type & N_STAB)
4440                 ;
4441             else if((nlist[i].n_type & N_TYPE) == N_SECT)
4442             {
4443                 if(nlist[i].n_type & N_EXT)
4444                 {
4445                     char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4446                     if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
4447                         ; // weak definition, and we already have a definition
4448                     else
4449                     {
4450                             ghciInsertStrHashTable(oc->fileName, symhash, nm,
4451                                                     image
4452                                                     + sections[nlist[i].n_sect-1].offset
4453                                                     - sections[nlist[i].n_sect-1].addr
4454                                                     + nlist[i].n_value);
4455                             oc->symbols[curSymbol++] = nm;
4456                     }
4457                 }
4458             }
4459         }
4460     }
4461
4462     commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4463     commonCounter = (unsigned long)commonStorage;
4464     if(symLC)
4465     {
4466         for(i=0;i<symLC->nsyms;i++)
4467         {
4468             if((nlist[i].n_type & N_TYPE) == N_UNDF
4469                     && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4470             {
4471                 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4472                 unsigned long sz = nlist[i].n_value;
4473
4474                 nlist[i].n_value = commonCounter;
4475
4476                 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4477                                        (void*)commonCounter);
4478                 oc->symbols[curSymbol++] = nm;
4479
4480                 commonCounter += sz;
4481             }
4482         }
4483     }
4484     return 1;
4485 }
4486
4487 static int ocResolve_MachO(ObjectCode* oc)
4488 {
4489     char *image = (char*) oc->image;
4490     struct mach_header *header = (struct mach_header*) image;
4491     struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4492     unsigned i;
4493     struct segment_command *segLC = NULL;
4494     struct section *sections;
4495     struct symtab_command *symLC = NULL;
4496     struct dysymtab_command *dsymLC = NULL;
4497     struct nlist *nlist;
4498
4499     for(i=0;i<header->ncmds;i++)
4500     {
4501         if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4502             segLC = (struct segment_command*) lc;
4503         else if(lc->cmd == LC_SYMTAB)
4504             symLC = (struct symtab_command*) lc;
4505         else if(lc->cmd == LC_DYSYMTAB)
4506             dsymLC = (struct dysymtab_command*) lc;
4507         lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4508     }
4509
4510     sections = (struct section*) (segLC+1);
4511     nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4512                   : NULL;
4513
4514     if(dsymLC)
4515     {
4516         unsigned long *indirectSyms
4517             = (unsigned long*) (image + dsymLC->indirectsymoff);
4518
4519         for(i=0;i<segLC->nsects;i++)
4520         {
4521             if(    !strcmp(sections[i].sectname,"__la_symbol_ptr")
4522                 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
4523                 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
4524             {
4525                 if(!resolveImports(oc,image,symLC,&sections[i],indirectSyms,nlist))
4526                     return 0;
4527             }
4528             else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
4529                 ||  !strcmp(sections[i].sectname,"__pointers"))
4530             {
4531                 if(!resolveImports(oc,image,symLC,&sections[i],indirectSyms,nlist))
4532                     return 0;
4533             }
4534             else if(!strcmp(sections[i].sectname,"__jump_table"))
4535             {
4536                 if(!resolveImports(oc,image,symLC,&sections[i],indirectSyms,nlist))
4537                     return 0;
4538             }
4539         }
4540     }
4541
4542     for(i=0;i<segLC->nsects;i++)
4543     {
4544         if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,&sections[i]))
4545             return 0;
4546     }
4547
4548 #if defined (powerpc_HOST_ARCH)
4549     ocFlushInstructionCache( oc );
4550 #endif
4551
4552     return 1;
4553 }
4554
4555 #ifdef powerpc_HOST_ARCH
4556 /*
4557  * The Mach-O object format uses leading underscores. But not everywhere.
4558  * There is a small number of runtime support functions defined in
4559  * libcc_dynamic.a whose name does not have a leading underscore.
4560  * As a consequence, we can't get their address from C code.
4561  * We have to use inline assembler just to take the address of a function.
4562  * Yuck.
4563  */
4564
4565 static void machoInitSymbolsWithoutUnderscore()
4566 {
4567     extern void* symbolsWithoutUnderscore[];
4568     void **p = symbolsWithoutUnderscore;
4569     __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4570
4571 #undef Sym
4572 #define SymI_NeedsProto(x)  \
4573     __asm__ volatile(".long " # x);
4574
4575     RTS_MACHO_NOUNDERLINE_SYMBOLS
4576
4577     __asm__ volatile(".text");
4578
4579 #undef Sym
4580 #define SymI_NeedsProto(x)  \
4581     ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4582
4583     RTS_MACHO_NOUNDERLINE_SYMBOLS
4584
4585 #undef Sym
4586 }
4587 #endif
4588
4589 /*
4590  * Figure out by how much to shift the entire Mach-O file in memory
4591  * when loading so that its single segment ends up 16-byte-aligned
4592  */
4593 static int machoGetMisalignment( FILE * f )
4594 {
4595     struct mach_header header;
4596     int misalignment;
4597
4598     fread(&header, sizeof(header), 1, f);
4599     rewind(f);
4600
4601 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
4602     if(header.magic != MH_MAGIC_64)
4603         return 0;
4604 #else
4605     if(header.magic != MH_MAGIC)
4606         return 0;
4607 #endif
4608
4609     misalignment = (header.sizeofcmds + sizeof(header))
4610                     & 0xF;
4611
4612     return misalignment ? (16 - misalignment) : 0;
4613 }
4614
4615 #endif
4616