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