ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.93 2002/06/10 02:13:03 matthewc Exp $
   3  *
   4  * (c) The GHC Team, 2000, 2001
   5  *
   6  * RTS Object Linker
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #if 0
  11 #include "PosixSource.h"
  12 #endif
  13 #include "Rts.h"
  14 #include "RtsFlags.h"
  15 #include "HsFFI.h"
  16 #include "Hash.h"
  17 #include "Linker.h"
  18 #include "LinkerInternals.h"
  19 #include "RtsUtils.h"
  20 #include "StoragePriv.h"
  21 #include "Schedule.h"
  22
  23 #ifdef HAVE_SYS_TYPES_H
  24 #include <sys/types.h>
  25 #endif
  26
  27 #ifdef HAVE_SYS_STAT_H
  28 #include <sys/stat.h>
  29 #endif
  30
  31 #ifdef HAVE_DLFCN_H
  32 #include <dlfcn.h>
  33 #endif
  34
  35 #if defined(cygwin32_TARGET_OS)
  36 #ifdef HAVE_DIRENT_H
  37 #include <dirent.h>
  38 #endif
  39
  40 #ifdef HAVE_SYS_TIME_H
  41 #include <sys/time.h>
  42 #endif
  43 #include <regex.h>
  44 #include <sys/fcntl.h>
  45 #include <sys/termios.h>
  46 #include <sys/utime.h>
  47 #include <sys/utsname.h>
  48 #include <sys/wait.h>
  49 #endif
  50
  51 #if defined(ia64_TARGET_ARCH)
  52 #define USE_MMAP
  53 #include <fcntl.h>
  54 #include <sys/mman.h>
  55 #endif
  56
  57 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
  58 #  define OBJFORMAT_ELF
  59 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
  60 #  define OBJFORMAT_PEi386
  61 #  include <windows.h>
  62 #endif
  63
  64 /* Hash table mapping symbol names to Symbol */
  65 /*Str*/HashTable *symhash;
  66
  67 #if defined(OBJFORMAT_ELF)
  68 static int ocVerifyImage_ELF    ( ObjectCode* oc );
  69 static int ocGetNames_ELF       ( ObjectCode* oc );
  70 static int ocResolve_ELF        ( ObjectCode* oc );
  71 #elif defined(OBJFORMAT_PEi386)
  72 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
  73 static int ocGetNames_PEi386    ( ObjectCode* oc );
  74 static int ocResolve_PEi386     ( ObjectCode* oc );
  75 #endif
  76
  77 /* -----------------------------------------------------------------------------
  78  * Built-in symbols from the RTS
  79  */
  80
  81 typedef struct _RtsSymbolVal {
  82     char   *lbl;
  83     void   *addr;
  84 } RtsSymbolVal;
  85
  86
  87 #if !defined(PAR)
  88 #define Maybe_ForeignObj        SymX(mkForeignObjzh_fast)
  89
  90 #define Maybe_Stable_Names      SymX(mkWeakzh_fast)                     \
  91                                 SymX(makeStableNamezh_fast)             \
  92                                 SymX(finalizzeWeakzh_fast)
  93 #else
  94 /* These are not available in GUM!!! -- HWL */
  95 #define Maybe_ForeignObj
  96 #define Maybe_Stable_Names
  97 #endif
  98
  99 #if !defined (mingw32_TARGET_OS)
 100 #define RTS_POSIX_ONLY_SYMBOLS                  \
 101       SymX(stg_sig_install)                     \
 102       Sym(nocldstop)
 103 #endif
 104
 105 #if defined (cygwin32_TARGET_OS)
 106 #define RTS_MINGW_ONLY_SYMBOLS /**/
 107 /* Don't have the ability to read import libs / archives, so
 108  * we have to stupidly list a lot of what libcygwin.a
 109  * exports; sigh.
 110  */
 111 #define RTS_CYGWIN_ONLY_SYMBOLS                 \
 112       SymX(regfree)                             \
 113       SymX(regexec)                             \
 114       SymX(regerror)                            \
 115       SymX(regcomp)                             \
 116       SymX(__errno)                             \
 117       SymX(access)                              \
 118       SymX(chmod)                               \
 119       SymX(chdir)                               \
 120       SymX(close)                               \
 121       SymX(creat)                               \
 122       SymX(dup)                                 \
 123       SymX(dup2)                                \
 124       SymX(fstat)                               \
 125       SymX(fcntl)                               \
 126       SymX(getcwd)                              \
 127       SymX(getenv)                              \
 128       SymX(lseek)                               \
 129       SymX(open)                                \
 130       SymX(fpathconf)                           \
 131       SymX(pathconf)                            \
 132       SymX(stat)                                \
 133       SymX(pow)                                 \
 134       SymX(tanh)                                \
 135       SymX(cosh)                                \
 136       SymX(sinh)                                \
 137       SymX(atan)                                \
 138       SymX(acos)                                \
 139       SymX(asin)                                \
 140       SymX(tan)                                 \
 141       SymX(cos)                                 \
 142       SymX(sin)                                 \
 143       SymX(exp)                                 \
 144       SymX(log)                                 \
 145       SymX(sqrt)                                \
 146       SymX(localtime_r)                         \
 147       SymX(gmtime_r)                            \
 148       SymX(mktime)                              \
 149       Sym(_imp___tzname)                        \
 150       SymX(gettimeofday)                        \
 151       SymX(timezone)                            \
 152       SymX(tcgetattr)                           \
 153       SymX(tcsetattr)                           \
 154       SymX(memcpy)                              \
 155       SymX(memmove)                             \
 156       SymX(realloc)                             \
 157       SymX(malloc)                              \
 158       SymX(free)                                \
 159       SymX(fork)                                \
 160       SymX(lstat)                               \
 161       SymX(isatty)                              \
 162       SymX(mkdir)                               \
 163       SymX(opendir)                             \
 164       SymX(readdir)                             \
 165       SymX(rewinddir)                           \
 166       SymX(closedir)                            \
 167       SymX(link)                                \
 168       SymX(mkfifo)                              \
 169       SymX(pipe)                                \
 170       SymX(read)                                \
 171       SymX(rename)                              \
 172       SymX(rmdir)                               \
 173       SymX(select)                              \
 174       SymX(system)                              \
 175       SymX(write)                               \
 176       SymX(strcmp)                              \
 177       SymX(strcpy)                              \
 178       SymX(strncpy)                             \
 179       SymX(strerror)                            \
 180       SymX(sigaddset)                           \
 181       SymX(sigemptyset)                         \
 182       SymX(sigprocmask)                         \
 183       SymX(umask)                               \
 184       SymX(uname)                               \
 185       SymX(unlink)                              \
 186       SymX(utime)                               \
 187       SymX(waitpid)                             \
 188       Sym(__divdi3)                             \
 189       Sym(__udivdi3)                            \
 190       Sym(__moddi3)                             \
 191       Sym(__umoddi3)
 192
 193 #elif !defined(mingw32_TARGET_OS)
 194 #define RTS_MINGW_ONLY_SYMBOLS /**/
 195 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
 196 #else /* defined(mingw32_TARGET_OS) */
 197 #define RTS_POSIX_ONLY_SYMBOLS  /**/
 198 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
 199
 200 /* These are statically linked from the mingw libraries into the ghc
 201    executable, so we have to employ this hack. */
 202 #define RTS_MINGW_ONLY_SYMBOLS                  \
 203       SymX(memset)                              \
 204       SymX(memset)                              \
 205       SymX(inet_ntoa)                           \
 206       SymX(inet_addr)                           \
 207       SymX(htonl)                               \
 208       SymX(recvfrom)                            \
 209       SymX(listen)                              \
 210       SymX(bind)                                \
 211       SymX(shutdown)                            \
 212       SymX(connect)                             \
 213       SymX(htons)                               \
 214       SymX(ntohs)                               \
 215       SymX(getservbyname)                       \
 216       SymX(getservbyport)                       \
 217       SymX(getprotobynumber)                    \
 218       SymX(getprotobyname)                      \
 219       SymX(gethostbyname)                       \
 220       SymX(gethostbyaddr)                       \
 221       SymX(gethostname)                         \
 222       SymX(strcpy)                              \
 223       SymX(strncpy)                             \
 224       SymX(abort)                               \
 225       Sym(_alloca)                              \
 226       Sym(isxdigit)                             \
 227       Sym(isupper)                              \
 228       Sym(ispunct)                              \
 229       Sym(islower)                              \
 230       Sym(isspace)                              \
 231       Sym(isprint)                              \
 232       Sym(isdigit)                              \
 233       Sym(iscntrl)                              \
 234       Sym(isalpha)                              \
 235       Sym(isalnum)                              \
 236       SymX(strcmp)                              \
 237       SymX(memmove)                             \
 238       SymX(realloc)                             \
 239       SymX(malloc)                              \
 240       SymX(pow)                                 \
 241       SymX(tanh)                                \
 242       SymX(cosh)                                \
 243       SymX(sinh)                                \
 244       SymX(atan)                                \
 245       SymX(acos)                                \
 246       SymX(asin)                                \
 247       SymX(tan)                                 \
 248       SymX(cos)                                 \
 249       SymX(sin)                                 \
 250       SymX(exp)                                 \
 251       SymX(log)                                 \
 252       SymX(sqrt)                                \
 253       SymX(memcpy)                              \
 254       Sym(mktime)                               \
 255       Sym(_imp___timezone)                      \
 256       Sym(_imp___tzname)                        \
 257       Sym(_imp___iob)                           \
 258       Sym(localtime)                            \
 259       Sym(gmtime)                               \
 260       Sym(opendir)                              \
 261       Sym(readdir)                              \
 262       Sym(rewinddir)                            \
 263       Sym(closedir)                             \
 264       Sym(__divdi3)                             \
 265       Sym(__udivdi3)                            \
 266       Sym(__moddi3)                             \
 267       Sym(__umoddi3)
 268 #endif
 269
 270 #ifndef SMP
 271 # define MAIN_CAP_SYM SymX(MainCapability)
 272 #else
 273 # define MAIN_CAP_SYM
 274 #endif
 275
 276 #define RTS_SYMBOLS                             \
 277       Maybe_ForeignObj                          \
 278       Maybe_Stable_Names                        \
 279       Sym(StgReturn)                            \
 280       Sym(__stginit_GHCziPrim)                  \
 281       Sym(init_stack)                           \
 282       SymX(__stg_chk_0)                         \
 283       SymX(__stg_chk_1)                         \
 284       SymX(stg_chk_2)                           \
 285       SymX(stg_chk_3)                           \
 286       SymX(stg_chk_4)                           \
 287       SymX(stg_chk_5)                           \
 288       SymX(stg_chk_6)                           \
 289       SymX(stg_chk_7)                           \
 290       SymX(stg_chk_8)                           \
 291       Sym(stg_enterStackTop)                    \
 292       SymX(stg_gc_d1)                           \
 293       SymX(stg_gc_l1)                           \
 294       SymX(__stg_gc_enter_1)                    \
 295       SymX(stg_gc_enter_2)                      \
 296       SymX(stg_gc_enter_3)                      \
 297       SymX(stg_gc_enter_4)                      \
 298       SymX(stg_gc_enter_5)                      \
 299       SymX(stg_gc_enter_6)                      \
 300       SymX(stg_gc_enter_7)                      \
 301       SymX(stg_gc_enter_8)                      \
 302       SymX(stg_gc_f1)                           \
 303       SymX(stg_gc_noregs)                       \
 304       SymX(stg_gc_seq_1)                        \
 305       SymX(stg_gc_unbx_r1)                      \
 306       SymX(stg_gc_unpt_r1)                      \
 307       SymX(stg_gc_ut_0_1)                       \
 308       SymX(stg_gc_ut_1_0)                       \
 309       SymX(stg_gen_chk)                         \
 310       SymX(stg_yield_to_interpreter)            \
 311       SymX(ErrorHdrHook)                        \
 312       MAIN_CAP_SYM                              \
 313       SymX(MallocFailHook)                      \
 314       SymX(NoRunnableThreadsHook)               \
 315       SymX(OnExitHook)                          \
 316       SymX(OutOfHeapHook)                       \
 317       SymX(PatErrorHdrHook)                     \
 318       SymX(PostTraceHook)                       \
 319       SymX(PreTraceHook)                        \
 320       SymX(StackOverflowHook)                   \
 321       SymX(__encodeDouble)                      \
 322       SymX(__encodeFloat)                       \
 323       SymX(__gmpn_gcd_1)                        \
 324       SymX(__gmpz_cmp)                          \
 325       SymX(__gmpz_cmp_si)                       \
 326       SymX(__gmpz_cmp_ui)                       \
 327       SymX(__gmpz_get_si)                       \
 328       SymX(__gmpz_get_ui)                       \
 329       SymX(__int_encodeDouble)                  \
 330       SymX(__int_encodeFloat)                   \
 331       SymX(andIntegerzh_fast)                   \
 332       SymX(blockAsyncExceptionszh_fast)         \
 333       SymX(catchzh_fast)                        \
 334       SymX(cmp_thread)                          \
 335       SymX(complementIntegerzh_fast)            \
 336       SymX(cmpIntegerzh_fast)                   \
 337       SymX(cmpIntegerIntzh_fast)                \
 338       SymX(createAdjustor)                      \
 339       SymX(decodeDoublezh_fast)                 \
 340       SymX(decodeFloatzh_fast)                  \
 341       SymX(defaultsHook)                        \
 342       SymX(delayzh_fast)                        \
 343       SymX(deRefWeakzh_fast)                    \
 344       SymX(deRefStablePtrzh_fast)               \
 345       SymX(divExactIntegerzh_fast)              \
 346       SymX(divModIntegerzh_fast)                \
 347       SymX(forkzh_fast)                         \
 348       SymX(forkProcesszh_fast)                  \
 349       SymX(freeHaskellFunctionPtr)              \
 350       SymX(freeStablePtr)                       \
 351       SymX(gcdIntegerzh_fast)                   \
 352       SymX(gcdIntegerIntzh_fast)                \
 353       SymX(gcdIntzh_fast)                       \
 354       SymX(getProgArgv)                         \
 355       SymX(getStablePtr)                        \
 356       SymX(int2Integerzh_fast)                  \
 357       SymX(integer2Intzh_fast)                  \
 358       SymX(integer2Wordzh_fast)                 \
 359       SymX(isDoubleDenormalized)                \
 360       SymX(isDoubleInfinite)                    \
 361       SymX(isDoubleNaN)                         \
 362       SymX(isDoubleNegativeZero)                \
 363       SymX(isEmptyMVarzh_fast)                  \
 364       SymX(isFloatDenormalized)                 \
 365       SymX(isFloatInfinite)                     \
 366       SymX(isFloatNaN)                          \
 367       SymX(isFloatNegativeZero)                 \
 368       SymX(killThreadzh_fast)                   \
 369       SymX(makeStablePtrzh_fast)                \
 370       SymX(minusIntegerzh_fast)                 \
 371       SymX(mkApUpd0zh_fast)                     \
 372       SymX(myThreadIdzh_fast)                   \
 373       SymX(labelThreadzh_fast)                  \
 374       SymX(newArrayzh_fast)                     \
 375       SymX(newBCOzh_fast)                       \
 376       SymX(newByteArrayzh_fast)                 \
 377       SymX(newCAF)                              \
 378       SymX(newMVarzh_fast)                      \
 379       SymX(newMutVarzh_fast)                    \
 380       SymX(newPinnedByteArrayzh_fast)           \
 381       SymX(orIntegerzh_fast)                    \
 382       SymX(performGC)                           \
 383       SymX(plusIntegerzh_fast)                  \
 384       SymX(prog_argc)                           \
 385       SymX(prog_argv)                           \
 386       SymX(putMVarzh_fast)                      \
 387       SymX(quotIntegerzh_fast)                  \
 388       SymX(quotRemIntegerzh_fast)               \
 389       SymX(raisezh_fast)                        \
 390       SymX(remIntegerzh_fast)                   \
 391       SymX(resetNonBlockingFd)                  \
 392       SymX(resumeThread)                        \
 393       SymX(rts_apply)                           \
 394       SymX(rts_checkSchedStatus)                \
 395       SymX(rts_eval)                            \
 396       SymX(rts_evalIO)                          \
 397       SymX(rts_evalLazyIO)                      \
 398       SymX(rts_eval_)                           \
 399       SymX(rts_getAddr)                         \
 400       SymX(rts_getBool)                         \
 401       SymX(rts_getChar)                         \
 402       SymX(rts_getDouble)                       \
 403       SymX(rts_getFloat)                        \
 404       SymX(rts_getInt)                          \
 405       SymX(rts_getInt32)                        \
 406       SymX(rts_getPtr)                          \
 407       SymX(rts_getStablePtr)                    \
 408       SymX(rts_getThreadId)                     \
 409       SymX(rts_getWord)                         \
 410       SymX(rts_getWord32)                       \
 411       SymX(rts_mkAddr)                          \
 412       SymX(rts_mkBool)                          \
 413       SymX(rts_mkChar)                          \
 414       SymX(rts_mkDouble)                        \
 415       SymX(rts_mkFloat)                         \
 416       SymX(rts_mkInt)                           \
 417       SymX(rts_mkInt16)                         \
 418       SymX(rts_mkInt32)                         \
 419       SymX(rts_mkInt64)                         \
 420       SymX(rts_mkInt8)                          \
 421       SymX(rts_mkPtr)                           \
 422       SymX(rts_mkStablePtr)                     \
 423       SymX(rts_mkString)                        \
 424       SymX(rts_mkWord)                          \
 425       SymX(rts_mkWord16)                        \
 426       SymX(rts_mkWord32)                        \
 427       SymX(rts_mkWord64)                        \
 428       SymX(rts_mkWord8)                         \
 429       SymX(run_queue_hd)                        \
 430       SymX(setProgArgv)                         \
 431       SymX(shutdownHaskellAndExit)              \
 432       SymX(stable_ptr_table)                    \
 433       SymX(stackOverflow)                       \
 434       SymX(stg_CAF_BLACKHOLE_info)              \
 435       SymX(stg_CHARLIKE_closure)                \
 436       SymX(stg_EMPTY_MVAR_info)                 \
 437       SymX(stg_IND_STATIC_info)                 \
 438       SymX(stg_INTLIKE_closure)                 \
 439       SymX(stg_MUT_ARR_PTRS_FROZEN_info)        \
 440       SymX(stg_WEAK_info)                       \
 441       SymX(stg_ap_1_upd_info)                   \
 442       SymX(stg_ap_2_upd_info)                   \
 443       SymX(stg_ap_3_upd_info)                   \
 444       SymX(stg_ap_4_upd_info)                   \
 445       SymX(stg_ap_5_upd_info)                   \
 446       SymX(stg_ap_6_upd_info)                   \
 447       SymX(stg_ap_7_upd_info)                   \
 448       SymX(stg_ap_8_upd_info)                   \
 449       SymX(stg_exit)                            \
 450       SymX(stg_sel_0_upd_info)                  \
 451       SymX(stg_sel_10_upd_info)                 \
 452       SymX(stg_sel_11_upd_info)                 \
 453       SymX(stg_sel_12_upd_info)                 \
 454       SymX(stg_sel_13_upd_info)                 \
 455       SymX(stg_sel_14_upd_info)                 \
 456       SymX(stg_sel_15_upd_info)                 \
 457       SymX(stg_sel_1_upd_info)                  \
 458       SymX(stg_sel_2_upd_info)                  \
 459       SymX(stg_sel_3_upd_info)                  \
 460       SymX(stg_sel_4_upd_info)                  \
 461       SymX(stg_sel_5_upd_info)                  \
 462       SymX(stg_sel_6_upd_info)                  \
 463       SymX(stg_sel_7_upd_info)                  \
 464       SymX(stg_sel_8_upd_info)                  \
 465       SymX(stg_sel_9_upd_info)                  \
 466       SymX(stg_seq_frame_info)                  \
 467       SymX(stg_upd_frame_info)                  \
 468       SymX(__stg_update_PAP)                    \
 469       SymX(suspendThread)                       \
 470       SymX(takeMVarzh_fast)                     \
 471       SymX(timesIntegerzh_fast)                 \
 472       SymX(tryPutMVarzh_fast)                   \
 473       SymX(tryTakeMVarzh_fast)                  \
 474       SymX(unblockAsyncExceptionszh_fast)       \
 475       SymX(unsafeThawArrayzh_fast)              \
 476       SymX(waitReadzh_fast)                     \
 477       SymX(waitWritezh_fast)                    \
 478       SymX(word2Integerzh_fast)                 \
 479       SymX(xorIntegerzh_fast)                   \
 480       SymX(yieldzh_fast)
 481
 482 #ifdef SUPPORT_LONG_LONGS
 483 #define RTS_LONG_LONG_SYMS                      \
 484       SymX(int64ToIntegerzh_fast)               \
 485       SymX(word64ToIntegerzh_fast)
 486 #else
 487 #define RTS_LONG_LONG_SYMS /* nothing */
 488 #endif
 489
 490 #ifdef ia64_TARGET_ARCH
 491 /* force these symbols to be present */
 492 #define RTS_EXTRA_SYMBOLS                       \
 493       Sym(__divsf3)
 494 #else
 495 #define RTS_EXTRA_SYMBOLS /* nothing */
 496 #endif
 497
 498 /* entirely bogus claims about types of these symbols */
 499 #define Sym(vvv)  extern void (vvv);
 500 #define SymX(vvv) /**/
 501 RTS_SYMBOLS
 502 RTS_LONG_LONG_SYMS
 503 RTS_EXTRA_SYMBOLS
 504 RTS_POSIX_ONLY_SYMBOLS
 505 RTS_MINGW_ONLY_SYMBOLS
 506 RTS_CYGWIN_ONLY_SYMBOLS
 507 #undef Sym
 508 #undef SymX
 509
 510 #ifdef LEADING_UNDERSCORE
 511 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
 512 #else
 513 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
 514 #endif
 515
 516 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
 517                     (void*)(&(vvv)) },
 518 #define SymX(vvv) Sym(vvv)
 519
 520 static RtsSymbolVal rtsSyms[] = {
 521       RTS_SYMBOLS
 522       RTS_LONG_LONG_SYMS
 523       RTS_EXTRA_SYMBOLS
 524       RTS_POSIX_ONLY_SYMBOLS
 525       RTS_MINGW_ONLY_SYMBOLS
 526       RTS_CYGWIN_ONLY_SYMBOLS
 527       { 0, 0 } /* sentinel */
 528 };
 529
 530 /* -----------------------------------------------------------------------------
 531  * Insert symbols into hash tables, checking for duplicates.
 532  */
 533 static void ghciInsertStrHashTable ( char* obj_name,
 534                                      HashTable *table,
 535                                      char* key,
 536                                      void *data
 537                                    )
 538 {
 539    if (lookupHashTable(table, (StgWord)key) == NULL)
 540    {
 541       insertStrHashTable(table, (StgWord)key, data);
 542       return;
 543    }
 544    fprintf(stderr,
 545       "\n\n"
 546       "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
 547       "   %s\n"
 548       "whilst processing object file\n"
 549       "   %s\n"
 550       "This could be caused by:\n"
 551       "   * Loading two different object files which export the same symbol\n"
 552       "   * Specifying the same object file twice on the GHCi command line\n"
 553       "   * An incorrect `package.conf' entry, causing some object to be\n"
 554       "     loaded twice.\n"
 555       "GHCi cannot safely continue in this situation.  Exiting now.  Sorry.\n"
 556       "\n",
 557       (char*)key,
 558       obj_name
 559    );
 560    exit(1);
 561 }
 562
 563
 564 /* -----------------------------------------------------------------------------
 565  * initialize the object linker
 566  */
 567 #if defined(OBJFORMAT_ELF)
 568 static void *dl_prog_handle;
 569 #endif
 570
 571 void
 572 initLinker( void )
 573 {
 574     RtsSymbolVal *sym;
 575
 576     symhash = allocStrHashTable();
 577
 578     /* populate the symbol table with stuff from the RTS */
 579     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
 580         ghciInsertStrHashTable("(GHCi built-in symbols)",
 581                                symhash, sym->lbl, sym->addr);
 582     }
 583 #   if defined(OBJFORMAT_ELF)
 584     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 585 #   endif
 586 }
 587
 588 /* -----------------------------------------------------------------------------
 589  * Add a DLL from which symbols may be found.  In the ELF case, just
 590  * do RTLD_GLOBAL-style add, so no further messing around needs to
 591  * happen in order that symbols in the loaded .so are findable --
 592  * lookupSymbol() will subsequently see them by dlsym on the program's
 593  * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 594  *
 595  * In the PEi386 case, open the DLLs and put handles to them in a
 596  * linked list.  When looking for a symbol, try all handles in the
 597  * list.
 598  */
 599
 600 #if defined(OBJFORMAT_PEi386)
 601 /* A record for storing handles into DLLs. */
 602
 603 typedef
 604    struct _OpenedDLL {
 605       char*              name;
 606       struct _OpenedDLL* next;
 607       HINSTANCE instance;
 608    }
 609    OpenedDLL;
 610
 611 /* A list thereof. */
 612 static OpenedDLL* opened_dlls = NULL;
 613 #endif
 614
 615
 616
 617 char *
 618 addDLL( char *dll_name )
 619 {
 620 #  if defined(OBJFORMAT_ELF)
 621    void *hdl;
 622    char *errmsg;
 623
 624    hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
 625    if (hdl == NULL) {
 626       /* dlopen failed; return a ptr to the error msg. */
 627       errmsg = dlerror();
 628       if (errmsg == NULL) errmsg = "addDLL: unknown error";
 629       return errmsg;
 630    } else {
 631       return NULL;
 632    }
 633    /*NOTREACHED*/
 634
 635 #  elif defined(OBJFORMAT_PEi386)
 636
 637    /* Add this DLL to the list of DLLs in which to search for symbols.
 638       The path argument is ignored. */
 639    char*      buf;
 640    OpenedDLL* o_dll;
 641    HINSTANCE  instance;
 642
 643    /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
 644
 645    /* See if we've already got it, and ignore if so. */
 646    for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
 647       if (0 == strcmp(o_dll->name, dll_name))
 648          return NULL;
 649    }
 650
 651    buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
 652    sprintf(buf, "%s.DLL", dll_name);
 653    instance = LoadLibrary(buf);
 654    if (instance == NULL) {
 655          sprintf(buf, "%s.DRV", dll_name);              // KAA: allow loading of drivers (like winspool.drv)
 656          instance = LoadLibrary(buf);
 657          if (instance == NULL) {
 658                 free(buf);
 659
 660             /* LoadLibrary failed; return a ptr to the error msg. */
 661             return "addDLL: unknown error";
 662          }
 663    }
 664    free(buf);
 665
 666    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
 667    o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
 668    strcpy(o_dll->name, dll_name);
 669    o_dll->instance = instance;
 670    o_dll->next     = opened_dlls;
 671    opened_dlls     = o_dll;
 672
 673    return NULL;
 674 #  else
 675    barf("addDLL: not implemented on this platform");
 676 #  endif
 677 }
 678
 679 /* -----------------------------------------------------------------------------
 680  * lookup a symbol in the hash table
 681  */
 682 void *
 683 lookupSymbol( char *lbl )
 684 {
 685     void *val;
 686     ASSERT(symhash != NULL);
 687     val = lookupStrHashTable(symhash, lbl);
 688
 689     if (val == NULL) {
 690 #       if defined(OBJFORMAT_ELF)
 691         return dlsym(dl_prog_handle, lbl);
 692 #       elif defined(OBJFORMAT_PEi386)
 693         OpenedDLL* o_dll;
 694         void* sym;
 695         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
 696           /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
 697            if (lbl[0] == '_') {
 698               /* HACK: if the name has an initial underscore, try stripping
 699                  it off & look that up first. I've yet to verify whether there's
 700                  a Rule that governs whether an initial '_' *should always* be
 701                  stripped off when mapping from import lib name to the DLL name.
 702               */
 703               sym = GetProcAddress(o_dll->instance, (lbl+1));
 704               if (sym != NULL) {
 705                 /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
 706                 return sym;
 707               }
 708            }
 709            sym = GetProcAddress(o_dll->instance, lbl);
 710            if (sym != NULL) {
 711              /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
 712              return sym;
 713            }
 714         }
 715         return NULL;
 716 #       else
 717         ASSERT(2+2 == 5);
 718         return NULL;
 719 #       endif
 720     } else {
 721         return val;
 722     }
 723 }
 724
 725 static
 726 __attribute((unused))
 727 void *
 728 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 729 {
 730     void *val;
 731     val = lookupStrHashTable(oc->lochash, lbl);
 732
 733     if (val == NULL) {
 734         return NULL;
 735     } else {
 736         return val;
 737     }
 738 }
 739
 740
 741 /* -----------------------------------------------------------------------------
 742  * Debugging aid: look in GHCi's object symbol tables for symbols
 743  * within DELTA bytes of the specified address, and show their names.
 744  */
 745 #ifdef DEBUG
 746 void ghci_enquire ( char* addr );
 747
 748 void ghci_enquire ( char* addr )
 749 {
 750    int   i;
 751    char* sym;
 752    char* a;
 753    const int DELTA = 64;
 754    ObjectCode* oc;
 755    for (oc = objects; oc; oc = oc->next) {
 756       for (i = 0; i < oc->n_symbols; i++) {
 757          sym = oc->symbols[i];
 758          if (sym == NULL) continue;
 759          /* fprintf(stderr, "enquire %p %p\n", sym, oc->lochash); */
 760          a = NULL;
 761          if (oc->lochash != NULL)
 762             a = lookupStrHashTable(oc->lochash, sym);
 763          if (a == NULL)
 764             a = lookupStrHashTable(symhash, sym);
 765          if (a == NULL) {
 766             /* fprintf(stderr, "ghci_enquire: can't find %s\n", sym); */
 767          }
 768          else if (addr-DELTA <= a && a <= addr+DELTA) {
 769             fprintf(stderr, "%p + %3d  ==  `%s'\n", addr, a - addr, sym);
 770          }
 771       }
 772    }
 773 }
 774 #endif
 775
 776 #ifdef ia64_TARGET_ARCH
 777 static unsigned int PLTSize(void);
 778 #endif
 779
 780 /* -----------------------------------------------------------------------------
 781  * Load an obj (populate the global symbol table, but don't resolve yet)
 782  *
 783  * Returns: 1 if ok, 0 on error.
 784  */
 785 HsInt
 786 loadObj( char *path )
 787 {
 788    ObjectCode* oc;
 789    struct stat st;
 790    int r, n;
 791 #ifdef USE_MMAP
 792    int fd, pagesize;
 793    void *map_addr;
 794 #else
 795    FILE *f;
 796 #endif
 797
 798    /* fprintf(stderr, "loadObj %s\n", path ); */
 799
 800    /* Check that we haven't already loaded this object.  Don't give up
 801       at this stage; ocGetNames_* will barf later. */
 802    {
 803        ObjectCode *o;
 804        int is_dup = 0;
 805        for (o = objects; o; o = o->next) {
 806           if (0 == strcmp(o->fileName, path))
 807              is_dup = 1;
 808        }
 809        if (is_dup) {
 810          fprintf(stderr,
 811             "\n\n"
 812             "GHCi runtime linker: warning: looks like you're trying to load the\n"
 813             "same object file twice:\n"
 814             "   %s\n"
 815             "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
 816             "\n"
 817             , path);
 818        }
 819    }
 820
 821    oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
 822
 823 #  if defined(OBJFORMAT_ELF)
 824    oc->formatName = "ELF";
 825 #  elif defined(OBJFORMAT_PEi386)
 826    oc->formatName = "PEi386";
 827 #  else
 828    free(oc);
 829    barf("loadObj: not implemented on this platform");
 830 #  endif
 831
 832    r = stat(path, &st);
 833    if (r == -1) { return 0; }
 834
 835    /* sigh, strdup() isn't a POSIX function, so do it the long way */
 836    oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
 837    strcpy(oc->fileName, path);
 838
 839    oc->fileSize          = st.st_size;
 840    oc->symbols           = NULL;
 841    oc->sections          = NULL;
 842    oc->lochash           = allocStrHashTable();
 843    oc->proddables        = NULL;
 844
 845    /* chain it onto the list of objects */
 846    oc->next              = objects;
 847    objects               = oc;
 848
 849 #ifdef USE_MMAP
 850 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
 851
 852    /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
 853
 854    fd = open(path, O_RDONLY);
 855    if (fd == -1)
 856       barf("loadObj: can't open `%s'", path);
 857
 858    pagesize = getpagesize();
 859
 860 #ifdef ia64_TARGET_ARCH
 861    /* The PLT needs to be right before the object */
 862    n = ROUND_UP(PLTSize(), pagesize);
 863    oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
 864    if (oc->plt == MAP_FAILED)
 865       barf("loadObj: can't allocate PLT");
 866
 867    oc->pltIndex = 0;
 868    map_addr = oc->plt + n;
 869 #endif
 870
 871    n = ROUND_UP(oc->fileSize, pagesize);
 872    oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
 873    if (oc->image == MAP_FAILED)
 874       barf("loadObj: can't map `%s'", path);
 875
 876    close(fd);
 877
 878 #else /* !USE_MMAP */
 879
 880    oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
 881
 882    /* load the image into memory */
 883    f = fopen(path, "rb");
 884    if (!f)
 885        barf("loadObj: can't read `%s'", path);
 886
 887    n = fread ( oc->image, 1, oc->fileSize, f );
 888    if (n != oc->fileSize)
 889       barf("loadObj: error whilst reading `%s'", path);
 890
 891    fclose(f);
 892
 893 #endif /* USE_MMAP */
 894
 895    /* verify the in-memory image */
 896 #  if defined(OBJFORMAT_ELF)
 897    r = ocVerifyImage_ELF ( oc );
 898 #  elif defined(OBJFORMAT_PEi386)
 899    r = ocVerifyImage_PEi386 ( oc );
 900 #  else
 901    barf("loadObj: no verify method");
 902 #  endif
 903    if (!r) { return r; }
 904
 905    /* build the symbol list for this image */
 906 #  if defined(OBJFORMAT_ELF)
 907    r = ocGetNames_ELF ( oc );
 908 #  elif defined(OBJFORMAT_PEi386)
 909    r = ocGetNames_PEi386 ( oc );
 910 #  else
 911    barf("loadObj: no getNames method");
 912 #  endif
 913    if (!r) { return r; }
 914
 915    /* loaded, but not resolved yet */
 916    oc->status = OBJECT_LOADED;
 917
 918    return 1;
 919 }
 920
 921 /* -----------------------------------------------------------------------------
 922  * resolve all the currently unlinked objects in memory
 923  *
 924  * Returns: 1 if ok, 0 on error.
 925  */
 926 HsInt
 927 resolveObjs( void )
 928 {
 929     ObjectCode *oc;
 930     int r;
 931
 932     for (oc = objects; oc; oc = oc->next) {
 933         if (oc->status != OBJECT_RESOLVED) {
 934 #           if defined(OBJFORMAT_ELF)
 935             r = ocResolve_ELF ( oc );
 936 #           elif defined(OBJFORMAT_PEi386)
 937             r = ocResolve_PEi386 ( oc );
 938 #           else
 939             barf("resolveObjs: not implemented on this platform");
 940 #           endif
 941             if (!r) { return r; }
 942             oc->status = OBJECT_RESOLVED;
 943         }
 944     }
 945     return 1;
 946 }
 947
 948 /* -----------------------------------------------------------------------------
 949  * delete an object from the pool
 950  */
 951 HsInt
 952 unloadObj( char *path )
 953 {
 954     ObjectCode *oc, *prev;
 955
 956     ASSERT(symhash != NULL);
 957     ASSERT(objects != NULL);
 958
 959     prev = NULL;
 960     for (oc = objects; oc; prev = oc, oc = oc->next) {
 961         if (!strcmp(oc->fileName,path)) {
 962
 963             /* Remove all the mappings for the symbols within this
 964              * object..
 965              */
 966             {
 967                 int i;
 968                 for (i = 0; i < oc->n_symbols; i++) {
 969                    if (oc->symbols[i] != NULL) {
 970                        removeStrHashTable(symhash, oc->symbols[i], NULL);
 971                    }
 972                 }
 973             }
 974
 975             if (prev == NULL) {
 976                 objects = oc->next;
 977             } else {
 978                 prev->next = oc->next;
 979             }
 980
 981             /* We're going to leave this in place, in case there are
 982                any pointers from the heap into it: */
 983             /* free(oc->image); */
 984             free(oc->fileName);
 985             free(oc->symbols);
 986             free(oc->sections);
 987             /* The local hash table should have been freed at the end
 988                of the ocResolve_ call on it. */
 989             ASSERT(oc->lochash == NULL);
 990             free(oc);
 991             return 1;
 992         }
 993     }
 994
 995     belch("unloadObj: can't find `%s' to unload", path);
 996     return 0;
 997 }
 998
 999 /* -----------------------------------------------------------------------------
1000  * Sanity checking.  For each ObjectCode, maintain a list of address ranges
1001  * which may be prodded during relocation, and abort if we try and write
1002  * outside any of these.
1003  */
1004 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1005 {
1006    ProddableBlock* pb
1007       = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1008    /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
1009    ASSERT(size > 0);
1010    pb->start      = start;
1011    pb->size       = size;
1012    pb->next       = oc->proddables;
1013    oc->proddables = pb;
1014 }
1015
1016 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1017 {
1018    ProddableBlock* pb;
1019    for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1020       char* s = (char*)(pb->start);
1021       char* e = s + pb->size - 1;
1022       char* a = (char*)addr;
1023       /* Assumes that the biggest fixup involves a 4-byte write.  This
1024          probably needs to be changed to 8 (ie, +7) on 64-bit
1025          plats. */
1026       if (a >= s && (a+3) <= e) return;
1027    }
1028    barf("checkProddableBlock: invalid fixup in runtime linker");
1029 }
1030
1031 /* -----------------------------------------------------------------------------
1032  * Section management.
1033  */
1034 static void addSection ( ObjectCode* oc, SectionKind kind,
1035                          void* start, void* end )
1036 {
1037    Section* s   = stgMallocBytes(sizeof(Section), "addSection");
1038    s->start     = start;
1039    s->end       = end;
1040    s->kind      = kind;
1041    s->next      = oc->sections;
1042    oc->sections = s;
1043    /*
1044    fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
1045                    start, ((char*)end)-1, end - start + 1, kind );
1046    */
1047 }
1048
1049
1050
1051 /* --------------------------------------------------------------------------
1052  * PEi386 specifics (Win32 targets)
1053  * ------------------------------------------------------------------------*/
1054
1055 /* The information for this linker comes from
1056       Microsoft Portable Executable
1057       and Common Object File Format Specification
1058       revision 5.1 January 1998
1059    which SimonM says comes from the MS Developer Network CDs.
1060
1061    It can be found there (on older CDs), but can also be found
1062    online at:
1063
1064       http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1065
1066    (this is Rev 6.0 from February 1999).
1067
1068    Things move, so if that fails, try searching for it via
1069
1070       http://www.google.com/search?q=PE+COFF+specification
1071
1072    The ultimate reference for the PE format is the Winnt.h
1073    header file that comes with the Platform SDKs; as always,
1074    implementations will drift wrt their documentation.
1075
1076    A good background article on the PE format is Matt Pietrek's
1077    March 1994 article in Microsoft System Journal (MSJ)
1078    (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1079    Win32 Portable Executable File Format." The info in there
1080    has recently been updated in a two part article in
1081    MSDN magazine, issues Feb and March 2002,
1082    "Inside Windows: An In-Depth Look into the Win32 Portable
1083    Executable File Format"
1084
1085    John Levine's book "Linkers and Loaders" contains useful
1086    info on PE too.
1087 */
1088
1089
1090 #if defined(OBJFORMAT_PEi386)
1091
1092
1093
1094 typedef unsigned char  UChar;
1095 typedef unsigned short UInt16;
1096 typedef unsigned int   UInt32;
1097 typedef          int   Int32;
1098
1099
1100 typedef
1101    struct {
1102       UInt16 Machine;
1103       UInt16 NumberOfSections;
1104       UInt32 TimeDateStamp;
1105       UInt32 PointerToSymbolTable;
1106       UInt32 NumberOfSymbols;
1107       UInt16 SizeOfOptionalHeader;
1108       UInt16 Characteristics;
1109    }
1110    COFF_header;
1111
1112 #define sizeof_COFF_header 20
1113
1114
1115 typedef
1116    struct {
1117       UChar  Name[8];
1118       UInt32 VirtualSize;
1119       UInt32 VirtualAddress;
1120       UInt32 SizeOfRawData;
1121       UInt32 PointerToRawData;
1122       UInt32 PointerToRelocations;
1123       UInt32 PointerToLinenumbers;
1124       UInt16 NumberOfRelocations;
1125       UInt16 NumberOfLineNumbers;
1126       UInt32 Characteristics;
1127    }
1128    COFF_section;
1129
1130 #define sizeof_COFF_section 40
1131
1132
1133 typedef
1134    struct {
1135       UChar  Name[8];
1136       UInt32 Value;
1137       UInt16 SectionNumber;
1138       UInt16 Type;
1139       UChar  StorageClass;
1140       UChar  NumberOfAuxSymbols;
1141    }
1142    COFF_symbol;
1143
1144 #define sizeof_COFF_symbol 18
1145
1146
1147 typedef
1148    struct {
1149       UInt32 VirtualAddress;
1150       UInt32 SymbolTableIndex;
1151       UInt16 Type;
1152    }
1153    COFF_reloc;
1154
1155 #define sizeof_COFF_reloc 10
1156
1157
1158 /* From PE spec doc, section 3.3.2 */
1159 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1160    windows.h -- for the same purpose, but I want to know what I'm
1161    getting, here. */
1162 #define MYIMAGE_FILE_RELOCS_STRIPPED     0x0001
1163 #define MYIMAGE_FILE_EXECUTABLE_IMAGE    0x0002
1164 #define MYIMAGE_FILE_DLL                 0x2000
1165 #define MYIMAGE_FILE_SYSTEM              0x1000
1166 #define MYIMAGE_FILE_BYTES_REVERSED_HI   0x8000
1167 #define MYIMAGE_FILE_BYTES_REVERSED_LO   0x0080
1168 #define MYIMAGE_FILE_32BIT_MACHINE       0x0100
1169
1170 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1171 #define MYIMAGE_SYM_CLASS_EXTERNAL       2
1172 #define MYIMAGE_SYM_CLASS_STATIC         3
1173 #define MYIMAGE_SYM_UNDEFINED            0
1174
1175 /* From PE spec doc, section 4.1 */
1176 #define MYIMAGE_SCN_CNT_CODE             0x00000020
1177 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1178 #define MYIMAGE_SCN_LNK_NRELOC_OVFL      0x01000000
1179
1180 /* From PE spec doc, section 5.2.1 */
1181 #define MYIMAGE_REL_I386_DIR32           0x0006
1182 #define MYIMAGE_REL_I386_REL32           0x0014
1183
1184
1185 /* We use myindex to calculate array addresses, rather than
1186    simply doing the normal subscript thing.  That's because
1187    some of the above structs have sizes which are not
1188    a whole number of words.  GCC rounds their sizes up to a
1189    whole number of words, which means that the address calcs
1190    arising from using normal C indexing or pointer arithmetic
1191    are just plain wrong.  Sigh.
1192 */
1193 static UChar *
1194 myindex ( int scale, void* base, int index )
1195 {
1196    return
1197       ((UChar*)base) + scale * index;
1198 }
1199
1200
1201 static void
1202 printName ( UChar* name, UChar* strtab )
1203 {
1204    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1205       UInt32 strtab_offset = * (UInt32*)(name+4);
1206       fprintf ( stderr, "%s", strtab + strtab_offset );
1207    } else {
1208       int i;
1209       for (i = 0; i < 8; i++) {
1210          if (name[i] == 0) break;
1211          fprintf ( stderr, "%c", name[i] );
1212       }
1213    }
1214 }
1215
1216
1217 static void
1218 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1219 {
1220    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1221       UInt32 strtab_offset = * (UInt32*)(name+4);
1222       strncpy ( dst, strtab+strtab_offset, dstSize );
1223       dst[dstSize-1] = 0;
1224    } else {
1225       int i = 0;
1226       while (1) {
1227          if (i >= 8) break;
1228          if (name[i] == 0) break;
1229          dst[i] = name[i];
1230          i++;
1231       }
1232       dst[i] = 0;
1233    }
1234 }
1235
1236
1237 static UChar *
1238 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1239 {
1240    UChar* newstr;
1241    /* If the string is longer than 8 bytes, look in the
1242       string table for it -- this will be correctly zero terminated.
1243    */
1244    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1245       UInt32 strtab_offset = * (UInt32*)(name+4);
1246       return ((UChar*)strtab) + strtab_offset;
1247    }
1248    /* Otherwise, if shorter than 8 bytes, return the original,
1249       which by defn is correctly terminated.
1250    */
1251    if (name[7]==0) return name;
1252    /* The annoying case: 8 bytes.  Copy into a temporary
1253       (which is never freed ...)
1254    */
1255    newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1256    ASSERT(newstr);
1257    strncpy(newstr,name,8);
1258    newstr[8] = 0;
1259    return newstr;
1260 }
1261
1262
1263 /* Just compares the short names (first 8 chars) */
1264 static COFF_section *
1265 findPEi386SectionCalled ( ObjectCode* oc,  char* name )
1266 {
1267    int i;
1268    COFF_header* hdr
1269       = (COFF_header*)(oc->image);
1270    COFF_section* sectab
1271       = (COFF_section*) (
1272            ((UChar*)(oc->image))
1273            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1274         );
1275    for (i = 0; i < hdr->NumberOfSections; i++) {
1276       UChar* n1;
1277       UChar* n2;
1278       COFF_section* section_i
1279          = (COFF_section*)
1280            myindex ( sizeof_COFF_section, sectab, i );
1281       n1 = (UChar*) &(section_i->Name);
1282       n2 = name;
1283       if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1284           n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1285           n1[6]==n2[6] && n1[7]==n2[7])
1286          return section_i;
1287    }
1288
1289    return NULL;
1290 }
1291
1292
1293 static void
1294 zapTrailingAtSign ( UChar* sym )
1295 {
1296 #  define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1297    int i, j;
1298    if (sym[0] == 0) return;
1299    i = 0;
1300    while (sym[i] != 0) i++;
1301    i--;
1302    j = i;
1303    while (j > 0 && my_isdigit(sym[j])) j--;
1304    if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1305 #  undef my_isdigit
1306 }
1307
1308
1309 static int
1310 ocVerifyImage_PEi386 ( ObjectCode* oc )
1311 {
1312    int i;
1313    UInt32 j, noRelocs;
1314    COFF_header*  hdr;
1315    COFF_section* sectab;
1316    COFF_symbol*  symtab;
1317    UChar*        strtab;
1318    /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
1319    hdr = (COFF_header*)(oc->image);
1320    sectab = (COFF_section*) (
1321                ((UChar*)(oc->image))
1322                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1323             );
1324    symtab = (COFF_symbol*) (
1325                ((UChar*)(oc->image))
1326                + hdr->PointerToSymbolTable
1327             );
1328    strtab = ((UChar*)symtab)
1329             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1330
1331    if (hdr->Machine != 0x14c) {
1332       belch("Not x86 PEi386");
1333       return 0;
1334    }
1335    if (hdr->SizeOfOptionalHeader != 0) {
1336       belch("PEi386 with nonempty optional header");
1337       return 0;
1338    }
1339    if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1340         (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1341         (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1342         (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1343       belch("Not a PEi386 object file");
1344       return 0;
1345    }
1346    if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1347         /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1348       belch("Invalid PEi386 word size or endiannness: %d",
1349             (int)(hdr->Characteristics));
1350       return 0;
1351    }
1352    /* If the string table size is way crazy, this might indicate that
1353       there are more than 64k relocations, despite claims to the
1354       contrary.  Hence this test. */
1355    /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1356 #if 0
1357    if ( (*(UInt32*)strtab) > 600000 ) {
1358       /* Note that 600k has no special significance other than being
1359          big enough to handle the almost-2MB-sized lumps that
1360          constitute HSwin32*.o. */
1361       belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1362       return 0;
1363    }
1364 #endif
1365
1366    /* No further verification after this point; only debug printing. */
1367    i = 0;
1368    IF_DEBUG(linker, i=1);
1369    if (i == 0) return 1;
1370
1371    fprintf ( stderr,
1372              "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1373    fprintf ( stderr,
1374              "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1375    fprintf ( stderr,
1376              "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1377
1378    fprintf ( stderr, "\n" );
1379    fprintf ( stderr,
1380              "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
1381    fprintf ( stderr,
1382              "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
1383    fprintf ( stderr,
1384              "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1385    fprintf ( stderr,
1386              "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
1387    fprintf ( stderr,
1388              "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
1389    fprintf ( stderr,
1390              "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
1391    fprintf ( stderr,
1392              "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
1393
1394    /* Print the section table. */
1395    fprintf ( stderr, "\n" );
1396    for (i = 0; i < hdr->NumberOfSections; i++) {
1397       COFF_reloc* reltab;
1398       COFF_section* sectab_i
1399          = (COFF_section*)
1400            myindex ( sizeof_COFF_section, sectab, i );
1401       fprintf ( stderr,
1402                 "\n"
1403                 "section %d\n"
1404                 "     name `",
1405                 i
1406               );
1407       printName ( sectab_i->Name, strtab );
1408       fprintf ( stderr,
1409                 "'\n"
1410                 "    vsize %d\n"
1411                 "    vaddr %d\n"
1412                 "  data sz %d\n"
1413                 " data off %d\n"
1414                 "  num rel %d\n"
1415                 "  off rel %d\n"
1416                 "  ptr raw 0x%x\n",
1417                 sectab_i->VirtualSize,
1418                 sectab_i->VirtualAddress,
1419                 sectab_i->SizeOfRawData,
1420                 sectab_i->PointerToRawData,
1421                 sectab_i->NumberOfRelocations,
1422                 sectab_i->PointerToRelocations,
1423                 sectab_i->PointerToRawData
1424               );
1425       reltab = (COFF_reloc*) (
1426                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1427                );
1428
1429       if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1430         /* If the relocation field (a short) has overflowed, the
1431          * real count can be found in the first reloc entry.
1432          *
1433          * See Section 4.1 (last para) of the PE spec (rev6.0).
1434          */
1435         COFF_reloc* rel = (COFF_reloc*)
1436                            myindex ( sizeof_COFF_reloc, reltab, 0 );
1437         noRelocs = rel->VirtualAddress;
1438         j = 1;
1439       } else {
1440         noRelocs = sectab_i->NumberOfRelocations;
1441         j = 0;
1442       }
1443
1444       for (; j < noRelocs; j++) {
1445          COFF_symbol* sym;
1446          COFF_reloc* rel = (COFF_reloc*)
1447                            myindex ( sizeof_COFF_reloc, reltab, j );
1448          fprintf ( stderr,
1449                    "        type 0x%-4x   vaddr 0x%-8x   name `",
1450                    (UInt32)rel->Type,
1451                    rel->VirtualAddress );
1452          sym = (COFF_symbol*)
1453                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1454          /* Hmm..mysterious looking offset - what's it for? SOF */
1455          printName ( sym->Name, strtab -10 );
1456          fprintf ( stderr, "'\n" );
1457       }
1458
1459       fprintf ( stderr, "\n" );
1460    }
1461    fprintf ( stderr, "\n" );
1462    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1463    fprintf ( stderr, "---START of string table---\n");
1464    for (i = 4; i < *(Int32*)strtab; i++) {
1465       if (strtab[i] == 0)
1466          fprintf ( stderr, "\n"); else
1467          fprintf( stderr, "%c", strtab[i] );
1468    }
1469    fprintf ( stderr, "--- END  of string table---\n");
1470
1471    fprintf ( stderr, "\n" );
1472    i = 0;
1473    while (1) {
1474       COFF_symbol* symtab_i;
1475       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1476       symtab_i = (COFF_symbol*)
1477                  myindex ( sizeof_COFF_symbol, symtab, i );
1478       fprintf ( stderr,
1479                 "symbol %d\n"
1480                 "     name `",
1481                 i
1482               );
1483       printName ( symtab_i->Name, strtab );
1484       fprintf ( stderr,
1485                 "'\n"
1486                 "    value 0x%x\n"
1487                 "   1+sec# %d\n"
1488                 "     type 0x%x\n"
1489                 "   sclass 0x%x\n"
1490                 "     nAux %d\n",
1491                 symtab_i->Value,
1492                 (Int32)(symtab_i->SectionNumber),
1493                 (UInt32)symtab_i->Type,
1494                 (UInt32)symtab_i->StorageClass,
1495                 (UInt32)symtab_i->NumberOfAuxSymbols
1496               );
1497       i += symtab_i->NumberOfAuxSymbols;
1498       i++;
1499    }
1500
1501    fprintf ( stderr, "\n" );
1502    return 1;
1503 }
1504
1505
1506 static int
1507 ocGetNames_PEi386 ( ObjectCode* oc )
1508 {
1509    COFF_header*  hdr;
1510    COFF_section* sectab;
1511    COFF_symbol*  symtab;
1512    UChar*        strtab;
1513
1514    UChar* sname;
1515    void*  addr;
1516    int    i;
1517
1518    hdr = (COFF_header*)(oc->image);
1519    sectab = (COFF_section*) (
1520                ((UChar*)(oc->image))
1521                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1522             );
1523    symtab = (COFF_symbol*) (
1524                ((UChar*)(oc->image))
1525                + hdr->PointerToSymbolTable
1526             );
1527    strtab = ((UChar*)(oc->image))
1528             + hdr->PointerToSymbolTable
1529             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1530
1531    /* Allocate space for any (local, anonymous) .bss sections. */
1532
1533    for (i = 0; i < hdr->NumberOfSections; i++) {
1534       UChar* zspace;
1535       COFF_section* sectab_i
1536          = (COFF_section*)
1537            myindex ( sizeof_COFF_section, sectab, i );
1538       if (0 != strcmp(sectab_i->Name, ".bss")) continue;
1539       if (sectab_i->VirtualSize == 0) continue;
1540       /* This is a non-empty .bss section.  Allocate zeroed space for
1541          it, and set its PointerToRawData field such that oc->image +
1542          PointerToRawData == addr_of_zeroed_space.  */
1543       zspace = stgCallocBytes(1, sectab_i->VirtualSize,
1544                               "ocGetNames_PEi386(anonymous bss)");
1545       sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
1546       addProddableBlock(oc, zspace, sectab_i->VirtualSize);
1547       /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
1548    }
1549
1550    /* Copy section information into the ObjectCode. */
1551
1552    for (i = 0; i < hdr->NumberOfSections; i++) {
1553       UChar* start;
1554       UChar* end;
1555       UInt32 sz;
1556
1557       SectionKind kind
1558          = SECTIONKIND_OTHER;
1559       COFF_section* sectab_i
1560          = (COFF_section*)
1561            myindex ( sizeof_COFF_section, sectab, i );
1562       IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1563
1564 #     if 0
1565       /* I'm sure this is the Right Way to do it.  However, the
1566          alternative of testing the sectab_i->Name field seems to
1567          work ok with Cygwin.
1568       */
1569       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1570           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1571          kind = SECTIONKIND_CODE_OR_RODATA;
1572 #     endif
1573
1574       if (0==strcmp(".text",sectab_i->Name) ||
1575           0==strcmp(".rodata",sectab_i->Name))
1576          kind = SECTIONKIND_CODE_OR_RODATA;
1577       if (0==strcmp(".data",sectab_i->Name) ||
1578           0==strcmp(".bss",sectab_i->Name))
1579          kind = SECTIONKIND_RWDATA;
1580
1581       ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
1582       sz = sectab_i->SizeOfRawData;
1583       if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
1584
1585       start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
1586       end   = start + sz - 1;
1587
1588       if (kind == SECTIONKIND_OTHER
1589           /* Ignore sections called which contain stabs debugging
1590              information. */
1591           && 0 != strcmp(".stab", sectab_i->Name)
1592           && 0 != strcmp(".stabstr", sectab_i->Name)
1593          ) {
1594          belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1595          return 0;
1596       }
1597
1598       if (kind != SECTIONKIND_OTHER && end >= start) {
1599          addSection(oc, kind, start, end);
1600          addProddableBlock(oc, start, end - start + 1);
1601       }
1602    }
1603
1604    /* Copy exported symbols into the ObjectCode. */
1605
1606    oc->n_symbols = hdr->NumberOfSymbols;
1607    oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
1608                                   "ocGetNames_PEi386(oc->symbols)");
1609    /* Call me paranoid; I don't care. */
1610    for (i = 0; i < oc->n_symbols; i++)
1611       oc->symbols[i] = NULL;
1612
1613    i = 0;
1614    while (1) {
1615       COFF_symbol* symtab_i;
1616       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1617       symtab_i = (COFF_symbol*)
1618                  myindex ( sizeof_COFF_symbol, symtab, i );
1619
1620       addr  = NULL;
1621
1622       if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1623           && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1624          /* This symbol is global and defined, viz, exported */
1625          /* for MYIMAGE_SYMCLASS_EXTERNAL
1626                 && !MYIMAGE_SYM_UNDEFINED,
1627             the address of the symbol is:
1628                 address of relevant section + offset in section
1629          */
1630          COFF_section* sectabent
1631             = (COFF_section*) myindex ( sizeof_COFF_section,
1632                                         sectab,
1633                                         symtab_i->SectionNumber-1 );
1634          addr = ((UChar*)(oc->image))
1635                 + (sectabent->PointerToRawData
1636                    + symtab_i->Value);
1637       }
1638       else
1639       if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1640           && symtab_i->Value > 0) {
1641          /* This symbol isn't in any section at all, ie, global bss.
1642             Allocate zeroed space for it. */
1643          addr = stgCallocBytes(1, symtab_i->Value,
1644                                "ocGetNames_PEi386(non-anonymous bss)");
1645          addSection(oc, SECTIONKIND_RWDATA, addr,
1646                         ((UChar*)addr) + symtab_i->Value - 1);
1647          addProddableBlock(oc, addr, symtab_i->Value);
1648          /* fprintf(stderr, "BSS      section at 0x%x\n", addr); */
1649       }
1650
1651       if (addr != NULL ) {
1652          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1653          /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname);  */
1654          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1655          ASSERT(i >= 0 && i < oc->n_symbols);
1656          /* cstring_from_COFF_symbol_name always succeeds. */
1657          oc->symbols[i] = sname;
1658          ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
1659       } else {
1660 #        if 0
1661          fprintf ( stderr,
1662                    "IGNORING symbol %d\n"
1663                    "     name `",
1664                    i
1665                  );
1666          printName ( symtab_i->Name, strtab );
1667          fprintf ( stderr,
1668                    "'\n"
1669                    "    value 0x%x\n"
1670                    "   1+sec# %d\n"
1671                    "     type 0x%x\n"
1672                    "   sclass 0x%x\n"
1673                    "     nAux %d\n",
1674                    symtab_i->Value,
1675                    (Int32)(symtab_i->SectionNumber),
1676                    (UInt32)symtab_i->Type,
1677                    (UInt32)symtab_i->StorageClass,
1678                    (UInt32)symtab_i->NumberOfAuxSymbols
1679                  );
1680 #        endif
1681       }
1682
1683       i += symtab_i->NumberOfAuxSymbols;
1684       i++;
1685    }
1686
1687    return 1;
1688 }
1689
1690
1691 static int
1692 ocResolve_PEi386 ( ObjectCode* oc )
1693 {
1694    COFF_header*  hdr;
1695    COFF_section* sectab;
1696    COFF_symbol*  symtab;
1697    UChar*        strtab;
1698
1699    UInt32        A;
1700    UInt32        S;
1701    UInt32*       pP;
1702
1703    int i;
1704    UInt32 j, noRelocs;
1705
1706    /* ToDo: should be variable-sized?  But is at least safe in the
1707       sense of buffer-overrun-proof. */
1708    char symbol[1000];
1709    /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1710
1711    hdr = (COFF_header*)(oc->image);
1712    sectab = (COFF_section*) (
1713                ((UChar*)(oc->image))
1714                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1715             );
1716    symtab = (COFF_symbol*) (
1717                ((UChar*)(oc->image))
1718                + hdr->PointerToSymbolTable
1719             );
1720    strtab = ((UChar*)(oc->image))
1721             + hdr->PointerToSymbolTable
1722             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1723
1724    for (i = 0; i < hdr->NumberOfSections; i++) {
1725       COFF_section* sectab_i
1726          = (COFF_section*)
1727            myindex ( sizeof_COFF_section, sectab, i );
1728       COFF_reloc* reltab
1729          = (COFF_reloc*) (
1730               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1731            );
1732
1733       /* Ignore sections called which contain stabs debugging
1734          information. */
1735       if (0 == strcmp(".stab", sectab_i->Name)
1736           || 0 == strcmp(".stabstr", sectab_i->Name))
1737          continue;
1738
1739       if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1740         /* If the relocation field (a short) has overflowed, the
1741          * real count can be found in the first reloc entry.
1742          *
1743          * See Section 4.1 (last para) of the PE spec (rev6.0).
1744          */
1745         COFF_reloc* rel = (COFF_reloc*)
1746                            myindex ( sizeof_COFF_reloc, reltab, 0 );
1747         noRelocs = rel->VirtualAddress;
1748         fprintf(stderr, "Overflown relocs: %u\n", noRelocs);
1749         j = 1;
1750       } else {
1751         noRelocs = sectab_i->NumberOfRelocations;
1752         j = 0;
1753       }
1754
1755
1756       for (; j < noRelocs; j++) {
1757          COFF_symbol* sym;
1758          COFF_reloc* reltab_j
1759             = (COFF_reloc*)
1760               myindex ( sizeof_COFF_reloc, reltab, j );
1761
1762          /* the location to patch */
1763          pP = (UInt32*)(
1764                  ((UChar*)(oc->image))
1765                  + (sectab_i->PointerToRawData
1766                     + reltab_j->VirtualAddress
1767                     - sectab_i->VirtualAddress )
1768               );
1769          /* the existing contents of pP */
1770          A = *pP;
1771          /* the symbol to connect to */
1772          sym = (COFF_symbol*)
1773                myindex ( sizeof_COFF_symbol,
1774                          symtab, reltab_j->SymbolTableIndex );
1775          IF_DEBUG(linker,
1776                   fprintf ( stderr,
1777                             "reloc sec %2d num %3d:  type 0x%-4x   "
1778                             "vaddr 0x%-8x   name `",
1779                             i, j,
1780                             (UInt32)reltab_j->Type,
1781                             reltab_j->VirtualAddress );
1782                             printName ( sym->Name, strtab );
1783                             fprintf ( stderr, "'\n" ));
1784
1785          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1786             COFF_section* section_sym
1787                = findPEi386SectionCalled ( oc, sym->Name );
1788             if (!section_sym) {
1789                belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1790                return 0;
1791             }
1792             S = ((UInt32)(oc->image))
1793                 + (section_sym->PointerToRawData
1794                    + sym->Value);
1795          } else {
1796             copyName ( sym->Name, strtab, symbol, 1000-1 );
1797             (void*)S = lookupLocalSymbol( oc, symbol );
1798             if ((void*)S != NULL) goto foundit;
1799             (void*)S = lookupSymbol( symbol );
1800             if ((void*)S != NULL) goto foundit;
1801             zapTrailingAtSign ( symbol );
1802             (void*)S = lookupLocalSymbol( oc, symbol );
1803             if ((void*)S != NULL) goto foundit;
1804             (void*)S = lookupSymbol( symbol );
1805             if ((void*)S != NULL) goto foundit;
1806             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1807             return 0;
1808            foundit:
1809          }
1810          checkProddableBlock(oc, pP);
1811          switch (reltab_j->Type) {
1812             case MYIMAGE_REL_I386_DIR32:
1813                *pP = A + S;
1814                break;
1815             case MYIMAGE_REL_I386_REL32:
1816                /* Tricky.  We have to insert a displacement at
1817                   pP which, when added to the PC for the _next_
1818                   insn, gives the address of the target (S).
1819                   Problem is to know the address of the next insn
1820                   when we only know pP.  We assume that this
1821                   literal field is always the last in the insn,
1822                   so that the address of the next insn is pP+4
1823                   -- hence the constant 4.
1824                   Also I don't know if A should be added, but so
1825                   far it has always been zero.
1826                */
1827                ASSERT(A==0);
1828                *pP = S - ((UInt32)pP) - 4;
1829                break;
1830             default:
1831                belch("%s: unhandled PEi386 relocation type %d",
1832                      oc->fileName, reltab_j->Type);
1833                return 0;
1834          }
1835
1836       }
1837    }
1838
1839    IF_DEBUG(linker, belch("completed %s", oc->fileName));
1840    return 1;
1841 }
1842
1843 #endif /* defined(OBJFORMAT_PEi386) */
1844
1845
1846 /* --------------------------------------------------------------------------
1847  * ELF specifics
1848  * ------------------------------------------------------------------------*/
1849
1850 #if defined(OBJFORMAT_ELF)
1851
1852 #define FALSE 0
1853 #define TRUE  1
1854
1855 #if defined(sparc_TARGET_ARCH)
1856 #  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
1857 #elif defined(i386_TARGET_ARCH)
1858 #  define ELF_TARGET_386    /* Used inside <elf.h> */
1859 #elif defined (ia64_TARGET_ARCH)
1860 #  define ELF_TARGET_IA64   /* Used inside <elf.h> */
1861 #  define ELF_64BIT
1862 #  define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
1863 #  define ELF_NEED_GOT      /* needs Global Offset Table */
1864 #  define ELF_NEED_PLT      /* needs Procedure Linkage Tables */
1865 #endif
1866
1867 #include <elf.h>
1868
1869 /*
1870  * Define a set of types which can be used for both ELF32 and ELF64
1871  */
1872
1873 #ifdef ELF_64BIT
1874 #define ELFCLASS    ELFCLASS64
1875 #define Elf_Addr    Elf64_Addr
1876 #define Elf_Word    Elf64_Word
1877 #define Elf_Sword   Elf64_Sword
1878 #define Elf_Ehdr    Elf64_Ehdr
1879 #define Elf_Phdr    Elf64_Phdr
1880 #define Elf_Shdr    Elf64_Shdr
1881 #define Elf_Sym     Elf64_Sym
1882 #define Elf_Rel     Elf64_Rel
1883 #define Elf_Rela    Elf64_Rela
1884 #define ELF_ST_TYPE ELF64_ST_TYPE
1885 #define ELF_ST_BIND ELF64_ST_BIND
1886 #define ELF_R_TYPE  ELF64_R_TYPE
1887 #define ELF_R_SYM   ELF64_R_SYM
1888 #else
1889 #define ELFCLASS    ELFCLASS32
1890 #define Elf_Addr    Elf32_Addr
1891 #define Elf_Word    Elf32_Word
1892 #define Elf_Sword   Elf32_Sword
1893 #define Elf_Ehdr    Elf32_Ehdr
1894 #define Elf_Phdr    Elf32_Phdr
1895 #define Elf_Shdr    Elf32_Shdr
1896 #define Elf_Sym     Elf32_Sym
1897 #define Elf_Rel     Elf32_Rel
1898 #define Elf_Rela    Elf32_Rela
1899 #define ELF_ST_TYPE ELF32_ST_TYPE
1900 #define ELF_ST_BIND ELF32_ST_BIND
1901 #define ELF_R_TYPE  ELF32_R_TYPE
1902 #define ELF_R_SYM   ELF32_R_SYM
1903 #endif
1904
1905
1906 /*
1907  * Functions to allocate entries in dynamic sections.  Currently we simply
1908  * preallocate a large number, and we don't check if a entry for the given
1909  * target already exists (a linear search is too slow).  Ideally these
1910  * entries would be associated with symbols.
1911  */
1912
1913 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
1914 #define GOT_SIZE            0x20000
1915 #define FUNCTION_TABLE_SIZE 0x10000
1916 #define PLT_SIZE            0x08000
1917
1918 #ifdef ELF_NEED_GOT
1919 static Elf_Addr got[GOT_SIZE];
1920 static unsigned int gotIndex;
1921 static Elf_Addr gp_val = (Elf_Addr)got;
1922
1923 static Elf_Addr
1924 allocateGOTEntry(Elf_Addr target)
1925 {
1926    Elf_Addr *entry;
1927
1928    if (gotIndex >= GOT_SIZE)
1929       barf("Global offset table overflow");
1930
1931    entry = &got[gotIndex++];
1932    *entry = target;
1933    return (Elf_Addr)entry;
1934 }
1935 #endif
1936
1937 #ifdef ELF_FUNCTION_DESC
1938 typedef struct {
1939    Elf_Addr ip;
1940    Elf_Addr gp;
1941 } FunctionDesc;
1942
1943 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
1944 static unsigned int functionTableIndex;
1945
1946 static Elf_Addr
1947 allocateFunctionDesc(Elf_Addr target)
1948 {
1949    FunctionDesc *entry;
1950
1951    if (functionTableIndex >= FUNCTION_TABLE_SIZE)
1952       barf("Function table overflow");
1953
1954    entry = &functionTable[functionTableIndex++];
1955    entry->ip = target;
1956    entry->gp = (Elf_Addr)gp_val;
1957    return (Elf_Addr)entry;
1958 }
1959
1960 static Elf_Addr
1961 copyFunctionDesc(Elf_Addr target)
1962 {
1963    FunctionDesc *olddesc = (FunctionDesc *)target;
1964    FunctionDesc *newdesc;
1965
1966    newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
1967    newdesc->gp = olddesc->gp;
1968    return (Elf_Addr)newdesc;
1969 }
1970 #endif
1971
1972 #ifdef ELF_NEED_PLT
1973 #ifdef ia64_TARGET_ARCH
1974 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
1975 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
1976
1977 static unsigned char plt_code[] =
1978 {
1979    /* taken from binutils bfd/elfxx-ia64.c */
1980    0x0b, 0x78, 0x00, 0x02, 0x00, 0x24,  /*   [MMI]       addl r15=0,r1;;    */
1981    0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0,  /*               ld8 r16=[r15],8    */
1982    0x01, 0x08, 0x00, 0x84,              /*               mov r14=r1;;       */
1983    0x11, 0x08, 0x00, 0x1e, 0x18, 0x10,  /*   [MIB]       ld8 r1=[r15]       */
1984    0x60, 0x80, 0x04, 0x80, 0x03, 0x00,  /*               mov b6=r16         */
1985    0x60, 0x00, 0x80, 0x00               /*               br.few b6;;        */
1986 };
1987
1988 /* If we can't get to the function descriptor via gp, take a local copy of it */
1989 #define PLT_RELOC(code, target) { \
1990    Elf64_Sxword rel_value = target - gp_val; \
1991    if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
1992       ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
1993    else \
1994       ia64_reloc_gprel22((Elf_Addr)code, target); \
1995    }
1996 #endif
1997
1998 typedef struct {
1999    unsigned char code[sizeof(plt_code)];
2000 } PLTEntry;
2001
2002 static Elf_Addr
2003 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2004 {
2005    PLTEntry *plt = (PLTEntry *)oc->plt;
2006    PLTEntry *entry;
2007
2008    if (oc->pltIndex >= PLT_SIZE)
2009       barf("Procedure table overflow");
2010
2011    entry = &plt[oc->pltIndex++];
2012    memcpy(entry->code, plt_code, sizeof(entry->code));
2013    PLT_RELOC(entry->code, target);
2014    return (Elf_Addr)entry;
2015 }
2016
2017 static unsigned int
2018 PLTSize(void)
2019 {
2020    return (PLT_SIZE * sizeof(PLTEntry));
2021 }
2022 #endif
2023
2024
2025 /*
2026  * Generic ELF functions
2027  */
2028
2029 static char *
2030 findElfSection ( void* objImage, Elf_Word sh_type )
2031 {
2032    char* ehdrC = (char*)objImage;
2033    Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2034    Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2035    char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2036    char* ptr = NULL;
2037    int i;
2038
2039    for (i = 0; i < ehdr->e_shnum; i++) {
2040       if (shdr[i].sh_type == sh_type
2041           /* Ignore the section header's string table. */
2042           && i != ehdr->e_shstrndx
2043           /* Ignore string tables named .stabstr, as they contain
2044              debugging info. */
2045           && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2046          ) {
2047          ptr = ehdrC + shdr[i].sh_offset;
2048          break;
2049       }
2050    }
2051    return ptr;
2052 }
2053
2054 #if defined(ia64_TARGET_ARCH)
2055 static Elf_Addr
2056 findElfSegment ( void* objImage, Elf_Addr vaddr )
2057 {
2058    char* ehdrC = (char*)objImage;
2059    Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2060    Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2061    Elf_Addr segaddr = 0;
2062    int i;
2063
2064    for (i = 0; i < ehdr->e_phnum; i++) {
2065       segaddr = phdr[i].p_vaddr;
2066       if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2067               break;
2068    }
2069    return segaddr;
2070 }
2071 #endif
2072
2073 static int
2074 ocVerifyImage_ELF ( ObjectCode* oc )
2075 {
2076    Elf_Shdr* shdr;
2077    Elf_Sym*  stab;
2078    int i, j, nent, nstrtab, nsymtabs;
2079    char* sh_strtab;
2080    char* strtab;
2081
2082    char*     ehdrC = (char*)(oc->image);
2083    Elf_Ehdr* ehdr  = (Elf_Ehdr*)ehdrC;
2084
2085    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2086        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2087        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2088        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2089       belch("%s: not an ELF object", oc->fileName);
2090       return 0;
2091    }
2092
2093    if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2094       belch("%s: unsupported ELF format", oc->fileName);
2095       return 0;
2096    }
2097
2098    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2099        IF_DEBUG(linker,belch( "Is little-endian" ));
2100    } else
2101    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2102        IF_DEBUG(linker,belch( "Is big-endian" ));
2103    } else {
2104        belch("%s: unknown endiannness", oc->fileName);
2105        return 0;
2106    }
2107
2108    if (ehdr->e_type != ET_REL) {
2109       belch("%s: not a relocatable object (.o) file", oc->fileName);
2110       return 0;
2111    }
2112    IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
2113
2114    IF_DEBUG(linker,belch( "Architecture is " ));
2115    switch (ehdr->e_machine) {
2116       case EM_386:   IF_DEBUG(linker,belch( "x86" )); break;
2117       case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
2118       case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2119       default:       IF_DEBUG(linker,belch( "unknown" ));
2120                      belch("%s: unknown architecture", oc->fileName);
2121                      return 0;
2122    }
2123
2124    IF_DEBUG(linker,belch(
2125              "\nSection header table: start %d, n_entries %d, ent_size %d",
2126              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
2127
2128    ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2129
2130    shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2131
2132    if (ehdr->e_shstrndx == SHN_UNDEF) {
2133       belch("%s: no section header string table", oc->fileName);
2134       return 0;
2135    } else {
2136       IF_DEBUG(linker,belch( "Section header string table is section %d",
2137                           ehdr->e_shstrndx));
2138       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2139    }
2140
2141    for (i = 0; i < ehdr->e_shnum; i++) {
2142       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
2143       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", (int)shdr[i].sh_type ));
2144       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", (int)shdr[i].sh_size ));
2145       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", (int)shdr[i].sh_offset ));
2146       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
2147                ehdrC + shdr[i].sh_offset,
2148                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2149
2150       if (shdr[i].sh_type == SHT_REL) {
2151           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
2152       } else if (shdr[i].sh_type == SHT_RELA) {
2153           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2154       } else {
2155           IF_DEBUG(linker,fprintf(stderr,"     "));
2156       }
2157       if (sh_strtab) {
2158           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2159       }
2160    }
2161
2162    IF_DEBUG(linker,belch( "\nString tables" ));
2163    strtab = NULL;
2164    nstrtab = 0;
2165    for (i = 0; i < ehdr->e_shnum; i++) {
2166       if (shdr[i].sh_type == SHT_STRTAB
2167           /* Ignore the section header's string table. */
2168           && i != ehdr->e_shstrndx
2169           /* Ignore string tables named .stabstr, as they contain
2170              debugging info. */
2171           && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2172          ) {
2173          IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
2174          strtab = ehdrC + shdr[i].sh_offset;
2175          nstrtab++;
2176       }
2177    }
2178    if (nstrtab != 1) {
2179       belch("%s: no string tables, or too many", oc->fileName);
2180       return 0;
2181    }
2182
2183    nsymtabs = 0;
2184    IF_DEBUG(linker,belch( "\nSymbol tables" ));
2185    for (i = 0; i < ehdr->e_shnum; i++) {
2186       if (shdr[i].sh_type != SHT_SYMTAB) continue;
2187       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2188       nsymtabs++;
2189       stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2190       nent = shdr[i].sh_size / sizeof(Elf_Sym);
2191       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
2192                nent,
2193                shdr[i].sh_size % sizeof(Elf_Sym)
2194              ));
2195       if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2196          belch("%s: non-integral number of symbol table entries", oc->fileName);
2197          return 0;
2198       }
2199       for (j = 0; j < nent; j++) {
2200          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
2201          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ",
2202                              (int)stab[j].st_shndx,
2203                              (int)stab[j].st_size,
2204                              (char*)stab[j].st_value ));
2205
2206          IF_DEBUG(linker,fprintf(stderr, "type=" ));
2207          switch (ELF_ST_TYPE(stab[j].st_info)) {
2208             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2209             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2210             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
2211             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2212             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
2213             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
2214          }
2215          IF_DEBUG(linker,fprintf(stderr, "  " ));
2216
2217          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2218          switch (ELF_ST_BIND(stab[j].st_info)) {
2219             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2220             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2221             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
2222             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
2223          }
2224          IF_DEBUG(linker,fprintf(stderr, "  " ));
2225
2226          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2227       }
2228    }
2229
2230    if (nsymtabs == 0) {
2231       belch("%s: didn't find any symbol tables", oc->fileName);
2232       return 0;
2233    }
2234
2235    return 1;
2236 }
2237
2238
2239 static int
2240 ocGetNames_ELF ( ObjectCode* oc )
2241 {
2242    int i, j, k, nent;
2243    Elf_Sym* stab;
2244
2245    char*     ehdrC    = (char*)(oc->image);
2246    Elf_Ehdr* ehdr     = (Elf_Ehdr*)ehdrC;
2247    char*     strtab   = findElfSection ( ehdrC, SHT_STRTAB );
2248    Elf_Shdr* shdr     = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2249
2250    ASSERT(symhash != NULL);
2251
2252    if (!strtab) {
2253       belch("%s: no strtab", oc->fileName);
2254       return 0;
2255    }
2256
2257    k = 0;
2258    for (i = 0; i < ehdr->e_shnum; i++) {
2259       /* Figure out what kind of section it is.  Logic derived from
2260          Figure 1.14 ("Special Sections") of the ELF document
2261          ("Portable Formats Specification, Version 1.1"). */
2262       Elf_Shdr    hdr    = shdr[i];
2263       SectionKind kind   = SECTIONKIND_OTHER;
2264       int         is_bss = FALSE;
2265
2266       if (hdr.sh_type == SHT_PROGBITS
2267           && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2268          /* .text-style section */
2269          kind = SECTIONKIND_CODE_OR_RODATA;
2270       }
2271       else
2272       if (hdr.sh_type == SHT_PROGBITS
2273           && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2274          /* .data-style section */
2275          kind = SECTIONKIND_RWDATA;
2276       }
2277       else
2278       if (hdr.sh_type == SHT_PROGBITS
2279           && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2280          /* .rodata-style section */
2281          kind = SECTIONKIND_CODE_OR_RODATA;
2282       }
2283       else
2284       if (hdr.sh_type == SHT_NOBITS
2285           && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2286          /* .bss-style section */
2287          kind = SECTIONKIND_RWDATA;
2288          is_bss = TRUE;
2289       }
2290
2291       if (is_bss && shdr[i].sh_size > 0) {
2292          /* This is a non-empty .bss section.  Allocate zeroed space for
2293             it, and set its .sh_offset field such that
2294             ehdrC + .sh_offset == addr_of_zeroed_space.  */
2295          char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2296                                        "ocGetNames_ELF(BSS)");
2297          shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2298          /*
2299          fprintf(stderr, "BSS section at 0x%x, size %d\n",
2300                          zspace, shdr[i].sh_size);
2301          */
2302       }
2303
2304       /* fill in the section info */
2305       if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2306          addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2307          addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2308                         ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2309       }
2310
2311       if (shdr[i].sh_type != SHT_SYMTAB) continue;
2312
2313       /* copy stuff into this module's object symbol table */
2314       stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2315       nent = shdr[i].sh_size / sizeof(Elf_Sym);
2316
2317       oc->n_symbols = nent;
2318       oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2319                                    "ocGetNames_ELF(oc->symbols)");
2320
2321       for (j = 0; j < nent; j++) {
2322
2323          char  isLocal = FALSE; /* avoids uninit-var warning */
2324          char* ad      = NULL;
2325          char* nm      = strtab + stab[j].st_name;
2326          int   secno   = stab[j].st_shndx;
2327
2328          /* Figure out if we want to add it; if so, set ad to its
2329             address.  Otherwise leave ad == NULL. */
2330
2331          if (secno == SHN_COMMON) {
2332             isLocal = FALSE;
2333             ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2334             /*
2335             fprintf(stderr, "COMMON symbol, size %d name %s\n",
2336                             stab[j].st_size, nm);
2337             */
2338             /* Pointless to do addProddableBlock() for this area,
2339                since the linker should never poke around in it. */
2340          }
2341          else
2342          if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2343                 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2344               )
2345               /* and not an undefined symbol */
2346               && stab[j].st_shndx != SHN_UNDEF
2347               /* and not in a "special section" */
2348               && stab[j].st_shndx < SHN_LORESERVE
2349               &&
2350               /* and it's a not a section or string table or anything silly */
2351               ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2352                 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2353                 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2354               )
2355             ) {
2356             /* Section 0 is the undefined section, hence > and not >=. */
2357             ASSERT(secno > 0 && secno < ehdr->e_shnum);
2358             /*
2359             if (shdr[secno].sh_type == SHT_NOBITS) {
2360                fprintf(stderr, "   BSS symbol, size %d off %d name %s\n",
2361                                stab[j].st_size, stab[j].st_value, nm);
2362             }
2363             */
2364             ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2365             if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2366                isLocal = TRUE;
2367             } else {
2368 #ifdef ELF_FUNCTION_DESC
2369                /* dlsym() and the initialisation table both give us function
2370                 * descriptors, so to be consistent we store function descriptors
2371                 * in the symbol table */
2372                if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2373                    ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2374 #endif
2375                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
2376                                       ad, oc->fileName, nm ));
2377                isLocal = FALSE;
2378             }
2379          }
2380
2381          /* And the decision is ... */
2382
2383          if (ad != NULL) {
2384             ASSERT(nm != NULL);
2385             oc->symbols[j] = nm;
2386             /* Acquire! */
2387             if (isLocal) {
2388                /* Ignore entirely. */
2389             } else {
2390                ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2391             }
2392          } else {
2393             /* Skip. */
2394             IF_DEBUG(linker,belch( "skipping `%s'",
2395                                    strtab + stab[j].st_name ));
2396             /*
2397             fprintf(stderr,
2398                     "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
2399                     (int)ELF_ST_BIND(stab[j].st_info),
2400                     (int)ELF_ST_TYPE(stab[j].st_info),
2401                     (int)stab[j].st_shndx,
2402                     strtab + stab[j].st_name
2403                    );
2404             */
2405             oc->symbols[j] = NULL;
2406          }
2407
2408       }
2409    }
2410
2411    return 1;
2412 }
2413
2414 /* Do ELF relocations which lack an explicit addend.  All x86-linux
2415    relocations appear to be of this form. */
2416 static int
2417 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2418                          Elf_Shdr* shdr, int shnum,
2419                          Elf_Sym*  stab, char* strtab )
2420 {
2421    int j;
2422    char *symbol;
2423    Elf_Word* targ;
2424    Elf_Rel*  rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2425    int         nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2426    int target_shndx = shdr[shnum].sh_info;
2427    int symtab_shndx = shdr[shnum].sh_link;
2428
2429    stab  = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2430    targ  = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2431    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2432                           target_shndx, symtab_shndx ));
2433
2434    for (j = 0; j < nent; j++) {
2435       Elf_Addr offset = rtab[j].r_offset;
2436       Elf_Addr info   = rtab[j].r_info;
2437
2438       Elf_Addr  P  = ((Elf_Addr)targ) + offset;
2439       Elf_Word* pP = (Elf_Word*)P;
2440       Elf_Addr  A  = *pP;
2441       Elf_Addr  S;
2442       Elf_Addr  value;
2443
2444       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2445                              j, (void*)offset, (void*)info ));
2446       if (!info) {
2447          IF_DEBUG(linker,belch( " ZERO" ));
2448          S = 0;
2449       } else {
2450          Elf_Sym sym = stab[ELF_R_SYM(info)];
2451          /* First see if it is a local symbol. */
2452          if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2453             /* Yes, so we can get the address directly from the ELF symbol
2454                table. */
2455             symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2456             S = (Elf_Addr)
2457                 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2458                        + stab[ELF_R_SYM(info)].st_value);
2459
2460          } else {
2461             /* No, so look up the name in our global table. */
2462             symbol = strtab + sym.st_name;
2463             (void*)S = lookupSymbol( symbol );
2464          }
2465          if (!S) {
2466             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2467             return 0;
2468          }
2469          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2470       }
2471
2472       IF_DEBUG(linker,belch( "Reloc: P = %p   S = %p   A = %p",
2473                              (void*)P, (void*)S, (void*)A ));
2474       checkProddableBlock ( oc, pP );
2475
2476       value = S + A;
2477
2478       switch (ELF_R_TYPE(info)) {
2479 #        ifdef i386_TARGET_ARCH
2480          case R_386_32:   *pP = value;     break;
2481          case R_386_PC32: *pP = value - P; break;
2482 #        endif
2483          default:
2484             belch("%s: unhandled ELF relocation(Rel) type %d\n",
2485                   oc->fileName, ELF_R_TYPE(info));
2486             return 0;
2487       }
2488
2489    }
2490    return 1;
2491 }
2492
2493 /* Do ELF relocations for which explicit addends are supplied.
2494    sparc-solaris relocations appear to be of this form. */
2495 static int
2496 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2497                           Elf_Shdr* shdr, int shnum,
2498                           Elf_Sym*  stab, char* strtab )
2499 {
2500    int j;
2501    char *symbol;
2502    Elf_Addr targ;
2503    Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2504    int         nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2505    int target_shndx = shdr[shnum].sh_info;
2506    int symtab_shndx = shdr[shnum].sh_link;
2507
2508    stab  = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2509    targ  = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2510    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2511                           target_shndx, symtab_shndx ));
2512
2513    for (j = 0; j < nent; j++) {
2514 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2515       /* This #ifdef only serves to avoid unused-var warnings. */
2516       Elf_Addr  offset = rtab[j].r_offset;
2517       Elf_Addr  P      = targ + offset;
2518 #endif
2519       Elf_Addr  info   = rtab[j].r_info;
2520       Elf_Addr  A      = rtab[j].r_addend;
2521       Elf_Addr  S;
2522       Elf_Addr  value;
2523 #     if defined(sparc_TARGET_ARCH)
2524       Elf_Word* pP = (Elf_Word*)P;
2525       Elf_Word  w1, w2;
2526 #     elif defined(ia64_TARGET_ARCH)
2527       Elf64_Xword *pP = (Elf64_Xword *)P;
2528       Elf_Addr addr;
2529 #     endif
2530
2531       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p)   ",
2532                              j, (void*)offset, (void*)info,
2533                                 (void*)A ));
2534       if (!info) {
2535          IF_DEBUG(linker,belch( " ZERO" ));
2536          S = 0;
2537       } else {
2538          Elf_Sym sym = stab[ELF_R_SYM(info)];
2539          /* First see if it is a local symbol. */
2540          if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2541             /* Yes, so we can get the address directly from the ELF symbol
2542                table. */
2543             symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2544             S = (Elf_Addr)
2545                 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2546                        + stab[ELF_R_SYM(info)].st_value);
2547 #ifdef ELF_FUNCTION_DESC
2548             /* Make a function descriptor for this function */
2549             if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2550                S = allocateFunctionDesc(S + A);
2551                A = 0;
2552             }
2553 #endif
2554          } else {
2555             /* No, so look up the name in our global table. */
2556             symbol = strtab + sym.st_name;
2557             (void*)S = lookupSymbol( symbol );
2558
2559 #ifdef ELF_FUNCTION_DESC
2560             /* If a function, already a function descriptor - we would
2561                have to copy it to add an offset. */
2562             if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2563                assert(A == 0);
2564 #endif
2565          }
2566          if (!S) {
2567            belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2568            return 0;
2569          }
2570          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2571       }
2572
2573       IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n",
2574                                         (void*)P, (void*)S, (void*)A ));
2575       /* checkProddableBlock ( oc, (void*)P ); */
2576
2577       value = S + A;
2578
2579       switch (ELF_R_TYPE(info)) {
2580 #        if defined(sparc_TARGET_ARCH)
2581          case R_SPARC_WDISP30:
2582             w1 = *pP & 0xC0000000;
2583             w2 = (Elf_Word)((value - P) >> 2);
2584             ASSERT((w2 & 0xC0000000) == 0);
2585             w1 |= w2;
2586             *pP = w1;
2587             break;
2588          case R_SPARC_HI22:
2589             w1 = *pP & 0xFFC00000;
2590             w2 = (Elf_Word)(value >> 10);
2591             ASSERT((w2 & 0xFFC00000) == 0);
2592             w1 |= w2;
2593             *pP = w1;
2594             break;
2595          case R_SPARC_LO10:
2596             w1 = *pP & ~0x3FF;
2597             w2 = (Elf_Word)(value & 0x3FF);
2598             ASSERT((w2 & ~0x3FF) == 0);
2599             w1 |= w2;
2600             *pP = w1;
2601             break;
2602          /* According to the Sun documentation:
2603             R_SPARC_UA32
2604             This relocation type resembles R_SPARC_32, except it refers to an
2605             unaligned word. That is, the word to be relocated must be treated
2606             as four separate bytes with arbitrary alignment, not as a word
2607             aligned according to the architecture requirements.
2608
2609             (JRS: which means that freeloading on the R_SPARC_32 case
2610             is probably wrong, but hey ...)
2611          */
2612          case R_SPARC_UA32:
2613          case R_SPARC_32:
2614             w2 = (Elf_Word)value;
2615             *pP = w2;
2616             break;
2617 #        elif defined(ia64_TARGET_ARCH)
2618          case R_IA64_DIR64LSB:
2619          case R_IA64_FPTR64LSB:
2620             *pP = value;
2621             break;
2622          case R_IA64_SEGREL64LSB:
2623             addr = findElfSegment(ehdrC, value);
2624             *pP = value - addr;
2625             break;
2626          case R_IA64_GPREL22:
2627             ia64_reloc_gprel22(P, value);
2628             break;
2629          case R_IA64_LTOFF22:
2630          case R_IA64_LTOFF_FPTR22:
2631             addr = allocateGOTEntry(value);
2632             ia64_reloc_gprel22(P, addr);
2633             break;
2634          case R_IA64_PCREL21B:
2635             ia64_reloc_pcrel21(P, S, oc);
2636             break;
2637 #        endif
2638          default:
2639             belch("%s: unhandled ELF relocation(RelA) type %d\n",
2640                   oc->fileName, ELF_R_TYPE(info));
2641             return 0;
2642       }
2643
2644    }
2645    return 1;
2646 }
2647
2648 static int
2649 ocResolve_ELF ( ObjectCode* oc )
2650 {
2651    char *strtab;
2652    int   shnum, ok;
2653    Elf_Sym*  stab  = NULL;
2654    char*     ehdrC = (char*)(oc->image);
2655    Elf_Ehdr* ehdr  = (Elf_Ehdr*) ehdrC;
2656    Elf_Shdr* shdr  = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2657    char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2658
2659    /* first find "the" symbol table */
2660    stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2661
2662    /* also go find the string table */
2663    strtab = findElfSection ( ehdrC, SHT_STRTAB );
2664
2665    if (stab == NULL || strtab == NULL) {
2666       belch("%s: can't find string or symbol table", oc->fileName);
2667       return 0;
2668    }
2669
2670    /* Process the relocation sections. */
2671    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2672
2673       /* Skip sections called ".rel.stab".  These appear to contain
2674          relocation entries that, when done, make the stabs debugging
2675          info point at the right places.  We ain't interested in all
2676          dat jazz, mun. */
2677       if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2678          continue;
2679
2680       if (shdr[shnum].sh_type == SHT_REL ) {
2681          ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2682                                        shnum, stab, strtab );
2683          if (!ok) return ok;
2684       }
2685       else
2686       if (shdr[shnum].sh_type == SHT_RELA) {
2687          ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2688                                         shnum, stab, strtab );
2689          if (!ok) return ok;
2690       }
2691    }
2692
2693    /* Free the local symbol table; we won't need it again. */
2694    freeHashTable(oc->lochash, NULL);
2695    oc->lochash = NULL;
2696
2697    return 1;
2698 }
2699
2700
2701 /*
2702  * IA64 specifics
2703  * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2704  * at the front.  The following utility functions pack and unpack instructions, and
2705  * take care of the most common relocations.
2706  */
2707
2708 #ifdef ia64_TARGET_ARCH
2709
2710 static Elf64_Xword
2711 ia64_extract_instruction(Elf64_Xword *target)
2712 {
2713    Elf64_Xword w1, w2;
2714    int slot = (Elf_Addr)target & 3;
2715    (Elf_Addr)target &= ~3;
2716
2717    w1 = *target;
2718    w2 = *(target+1);
2719
2720    switch (slot)
2721    {
2722       case 0:
2723          return ((w1 >> 5) & 0x1ffffffffff);
2724       case 1:
2725          return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2726       case 2:
2727          return (w2 >> 23);
2728       default:
2729          barf("ia64_extract_instruction: invalid slot %p", target);
2730    }
2731 }
2732
2733 static void
2734 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2735 {
2736    int slot = (Elf_Addr)target & 3;
2737    (Elf_Addr)target &= ~3;
2738
2739    switch (slot)
2740    {
2741       case 0:
2742          *target |= value << 5;
2743          break;
2744       case 1:
2745          *target |= value << 46;
2746          *(target+1) |= value >> 18;
2747          break;
2748       case 2:
2749          *(target+1) |= value << 23;
2750          break;
2751    }
2752 }
2753
2754 static void
2755 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2756 {
2757    Elf64_Xword instruction;
2758    Elf64_Sxword rel_value;
2759
2760    rel_value = value - gp_val;
2761    if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2762       barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2763
2764    instruction = ia64_extract_instruction((Elf64_Xword *)target);
2765    instruction |= (((rel_value >> 0) & 0x07f) << 13)            /* imm7b */
2766                     | (((rel_value >> 7) & 0x1ff) << 27)        /* imm9d */
2767                     | (((rel_value >> 16) & 0x01f) << 22)       /* imm5c */
2768                     | ((Elf64_Xword)(rel_value < 0) << 36);     /* s */
2769    ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2770 }
2771
2772 static void
2773 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2774 {
2775    Elf64_Xword instruction;
2776    Elf64_Sxword rel_value;
2777    Elf_Addr entry;
2778
2779    entry = allocatePLTEntry(value, oc);
2780
2781    rel_value = (entry >> 4) - (target >> 4);
2782    if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2783       barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2784
2785    instruction = ia64_extract_instruction((Elf64_Xword *)target);
2786    instruction |= ((rel_value & 0xfffff) << 13)                 /* imm20b */
2787                     | ((Elf64_Xword)(rel_value < 0) << 36);     /* s */
2788    ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2789 }
2790
2791 #endif /* ia64 */
2792
2793 #endif /* ELF */