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