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