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