ghc/rts/Linker.c

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