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