ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.94 2002/06/11 08:06:33 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 #ifdef EM_IA_64
2119       case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
2120 #endif
2121       default:       IF_DEBUG(linker,belch( "unknown" ));
2122                      belch("%s: unknown architecture", oc->fileName);
2123                      return 0;
2124    }
2125
2126    IF_DEBUG(linker,belch(
2127              "\nSection header table: start %d, n_entries %d, ent_size %d",
2128              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
2129
2130    ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2131
2132    shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2133
2134    if (ehdr->e_shstrndx == SHN_UNDEF) {
2135       belch("%s: no section header string table", oc->fileName);
2136       return 0;
2137    } else {
2138       IF_DEBUG(linker,belch( "Section header string table is section %d",
2139                           ehdr->e_shstrndx));
2140       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2141    }
2142
2143    for (i = 0; i < ehdr->e_shnum; i++) {
2144       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
2145       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", (int)shdr[i].sh_type ));
2146       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", (int)shdr[i].sh_size ));
2147       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", (int)shdr[i].sh_offset ));
2148       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
2149                ehdrC + shdr[i].sh_offset,
2150                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2151
2152       if (shdr[i].sh_type == SHT_REL) {
2153           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
2154       } else if (shdr[i].sh_type == SHT_RELA) {
2155           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
2156       } else {
2157           IF_DEBUG(linker,fprintf(stderr,"     "));
2158       }
2159       if (sh_strtab) {
2160           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
2161       }
2162    }
2163
2164    IF_DEBUG(linker,belch( "\nString tables" ));
2165    strtab = NULL;
2166    nstrtab = 0;
2167    for (i = 0; i < ehdr->e_shnum; i++) {
2168       if (shdr[i].sh_type == SHT_STRTAB
2169           /* Ignore the section header's string table. */
2170           && i != ehdr->e_shstrndx
2171           /* Ignore string tables named .stabstr, as they contain
2172              debugging info. */
2173           && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2174          ) {
2175          IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
2176          strtab = ehdrC + shdr[i].sh_offset;
2177          nstrtab++;
2178       }
2179    }
2180    if (nstrtab != 1) {
2181       belch("%s: no string tables, or too many", oc->fileName);
2182       return 0;
2183    }
2184
2185    nsymtabs = 0;
2186    IF_DEBUG(linker,belch( "\nSymbol tables" ));
2187    for (i = 0; i < ehdr->e_shnum; i++) {
2188       if (shdr[i].sh_type != SHT_SYMTAB) continue;
2189       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
2190       nsymtabs++;
2191       stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2192       nent = shdr[i].sh_size / sizeof(Elf_Sym);
2193       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
2194                nent,
2195                shdr[i].sh_size % sizeof(Elf_Sym)
2196              ));
2197       if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2198          belch("%s: non-integral number of symbol table entries", oc->fileName);
2199          return 0;
2200       }
2201       for (j = 0; j < nent; j++) {
2202          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
2203          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ",
2204                              (int)stab[j].st_shndx,
2205                              (int)stab[j].st_size,
2206                              (char*)stab[j].st_value ));
2207
2208          IF_DEBUG(linker,fprintf(stderr, "type=" ));
2209          switch (ELF_ST_TYPE(stab[j].st_info)) {
2210             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
2211             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
2212             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
2213             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
2214             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
2215             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
2216          }
2217          IF_DEBUG(linker,fprintf(stderr, "  " ));
2218
2219          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
2220          switch (ELF_ST_BIND(stab[j].st_info)) {
2221             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
2222             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
2223             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
2224             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
2225          }
2226          IF_DEBUG(linker,fprintf(stderr, "  " ));
2227
2228          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
2229       }
2230    }
2231
2232    if (nsymtabs == 0) {
2233       belch("%s: didn't find any symbol tables", oc->fileName);
2234       return 0;
2235    }
2236
2237    return 1;
2238 }
2239
2240
2241 static int
2242 ocGetNames_ELF ( ObjectCode* oc )
2243 {
2244    int i, j, k, nent;
2245    Elf_Sym* stab;
2246
2247    char*     ehdrC    = (char*)(oc->image);
2248    Elf_Ehdr* ehdr     = (Elf_Ehdr*)ehdrC;
2249    char*     strtab   = findElfSection ( ehdrC, SHT_STRTAB );
2250    Elf_Shdr* shdr     = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2251
2252    ASSERT(symhash != NULL);
2253
2254    if (!strtab) {
2255       belch("%s: no strtab", oc->fileName);
2256       return 0;
2257    }
2258
2259    k = 0;
2260    for (i = 0; i < ehdr->e_shnum; i++) {
2261       /* Figure out what kind of section it is.  Logic derived from
2262          Figure 1.14 ("Special Sections") of the ELF document
2263          ("Portable Formats Specification, Version 1.1"). */
2264       Elf_Shdr    hdr    = shdr[i];
2265       SectionKind kind   = SECTIONKIND_OTHER;
2266       int         is_bss = FALSE;
2267
2268       if (hdr.sh_type == SHT_PROGBITS
2269           && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_EXECINSTR)) {
2270          /* .text-style section */
2271          kind = SECTIONKIND_CODE_OR_RODATA;
2272       }
2273       else
2274       if (hdr.sh_type == SHT_PROGBITS
2275           && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2276          /* .data-style section */
2277          kind = SECTIONKIND_RWDATA;
2278       }
2279       else
2280       if (hdr.sh_type == SHT_PROGBITS
2281           && (hdr.sh_flags & SHF_ALLOC) && !(hdr.sh_flags & SHF_WRITE)) {
2282          /* .rodata-style section */
2283          kind = SECTIONKIND_CODE_OR_RODATA;
2284       }
2285       else
2286       if (hdr.sh_type == SHT_NOBITS
2287           && (hdr.sh_flags & SHF_ALLOC) && (hdr.sh_flags & SHF_WRITE)) {
2288          /* .bss-style section */
2289          kind = SECTIONKIND_RWDATA;
2290          is_bss = TRUE;
2291       }
2292
2293       if (is_bss && shdr[i].sh_size > 0) {
2294          /* This is a non-empty .bss section.  Allocate zeroed space for
2295             it, and set its .sh_offset field such that
2296             ehdrC + .sh_offset == addr_of_zeroed_space.  */
2297          char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2298                                        "ocGetNames_ELF(BSS)");
2299          shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2300          /*
2301          fprintf(stderr, "BSS section at 0x%x, size %d\n",
2302                          zspace, shdr[i].sh_size);
2303          */
2304       }
2305
2306       /* fill in the section info */
2307       if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2308          addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2309          addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2310                         ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2311       }
2312
2313       if (shdr[i].sh_type != SHT_SYMTAB) continue;
2314
2315       /* copy stuff into this module's object symbol table */
2316       stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2317       nent = shdr[i].sh_size / sizeof(Elf_Sym);
2318
2319       oc->n_symbols = nent;
2320       oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2321                                    "ocGetNames_ELF(oc->symbols)");
2322
2323       for (j = 0; j < nent; j++) {
2324
2325          char  isLocal = FALSE; /* avoids uninit-var warning */
2326          char* ad      = NULL;
2327          char* nm      = strtab + stab[j].st_name;
2328          int   secno   = stab[j].st_shndx;
2329
2330          /* Figure out if we want to add it; if so, set ad to its
2331             address.  Otherwise leave ad == NULL. */
2332
2333          if (secno == SHN_COMMON) {
2334             isLocal = FALSE;
2335             ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2336             /*
2337             fprintf(stderr, "COMMON symbol, size %d name %s\n",
2338                             stab[j].st_size, nm);
2339             */
2340             /* Pointless to do addProddableBlock() for this area,
2341                since the linker should never poke around in it. */
2342          }
2343          else
2344          if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2345                 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2346               )
2347               /* and not an undefined symbol */
2348               && stab[j].st_shndx != SHN_UNDEF
2349               /* and not in a "special section" */
2350               && stab[j].st_shndx < SHN_LORESERVE
2351               &&
2352               /* and it's a not a section or string table or anything silly */
2353               ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2354                 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2355                 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2356               )
2357             ) {
2358             /* Section 0 is the undefined section, hence > and not >=. */
2359             ASSERT(secno > 0 && secno < ehdr->e_shnum);
2360             /*
2361             if (shdr[secno].sh_type == SHT_NOBITS) {
2362                fprintf(stderr, "   BSS symbol, size %d off %d name %s\n",
2363                                stab[j].st_size, stab[j].st_value, nm);
2364             }
2365             */
2366             ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2367             if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2368                isLocal = TRUE;
2369             } else {
2370 #ifdef ELF_FUNCTION_DESC
2371                /* dlsym() and the initialisation table both give us function
2372                 * descriptors, so to be consistent we store function descriptors
2373                 * in the symbol table */
2374                if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2375                    ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2376 #endif
2377                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
2378                                       ad, oc->fileName, nm ));
2379                isLocal = FALSE;
2380             }
2381          }
2382
2383          /* And the decision is ... */
2384
2385          if (ad != NULL) {
2386             ASSERT(nm != NULL);
2387             oc->symbols[j] = nm;
2388             /* Acquire! */
2389             if (isLocal) {
2390                /* Ignore entirely. */
2391             } else {
2392                ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2393             }
2394          } else {
2395             /* Skip. */
2396             IF_DEBUG(linker,belch( "skipping `%s'",
2397                                    strtab + stab[j].st_name ));
2398             /*
2399             fprintf(stderr,
2400                     "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
2401                     (int)ELF_ST_BIND(stab[j].st_info),
2402                     (int)ELF_ST_TYPE(stab[j].st_info),
2403                     (int)stab[j].st_shndx,
2404                     strtab + stab[j].st_name
2405                    );
2406             */
2407             oc->symbols[j] = NULL;
2408          }
2409
2410       }
2411    }
2412
2413    return 1;
2414 }
2415
2416 /* Do ELF relocations which lack an explicit addend.  All x86-linux
2417    relocations appear to be of this form. */
2418 static int
2419 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
2420                          Elf_Shdr* shdr, int shnum,
2421                          Elf_Sym*  stab, char* strtab )
2422 {
2423    int j;
2424    char *symbol;
2425    Elf_Word* targ;
2426    Elf_Rel*  rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
2427    int         nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
2428    int target_shndx = shdr[shnum].sh_info;
2429    int symtab_shndx = shdr[shnum].sh_link;
2430
2431    stab  = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2432    targ  = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
2433    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2434                           target_shndx, symtab_shndx ));
2435
2436    for (j = 0; j < nent; j++) {
2437       Elf_Addr offset = rtab[j].r_offset;
2438       Elf_Addr info   = rtab[j].r_info;
2439
2440       Elf_Addr  P  = ((Elf_Addr)targ) + offset;
2441       Elf_Word* pP = (Elf_Word*)P;
2442       Elf_Addr  A  = *pP;
2443       Elf_Addr  S;
2444       Elf_Addr  value;
2445
2446       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
2447                              j, (void*)offset, (void*)info ));
2448       if (!info) {
2449          IF_DEBUG(linker,belch( " ZERO" ));
2450          S = 0;
2451       } else {
2452          Elf_Sym sym = stab[ELF_R_SYM(info)];
2453          /* First see if it is a local symbol. */
2454          if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2455             /* Yes, so we can get the address directly from the ELF symbol
2456                table. */
2457             symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2458             S = (Elf_Addr)
2459                 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2460                        + stab[ELF_R_SYM(info)].st_value);
2461
2462          } else {
2463             /* No, so look up the name in our global table. */
2464             symbol = strtab + sym.st_name;
2465             (void*)S = lookupSymbol( symbol );
2466          }
2467          if (!S) {
2468             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2469             return 0;
2470          }
2471          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2472       }
2473
2474       IF_DEBUG(linker,belch( "Reloc: P = %p   S = %p   A = %p",
2475                              (void*)P, (void*)S, (void*)A ));
2476       checkProddableBlock ( oc, pP );
2477
2478       value = S + A;
2479
2480       switch (ELF_R_TYPE(info)) {
2481 #        ifdef i386_TARGET_ARCH
2482          case R_386_32:   *pP = value;     break;
2483          case R_386_PC32: *pP = value - P; break;
2484 #        endif
2485          default:
2486             belch("%s: unhandled ELF relocation(Rel) type %d\n",
2487                   oc->fileName, ELF_R_TYPE(info));
2488             return 0;
2489       }
2490
2491    }
2492    return 1;
2493 }
2494
2495 /* Do ELF relocations for which explicit addends are supplied.
2496    sparc-solaris relocations appear to be of this form. */
2497 static int
2498 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
2499                           Elf_Shdr* shdr, int shnum,
2500                           Elf_Sym*  stab, char* strtab )
2501 {
2502    int j;
2503    char *symbol;
2504    Elf_Addr targ;
2505    Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
2506    int         nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
2507    int target_shndx = shdr[shnum].sh_info;
2508    int symtab_shndx = shdr[shnum].sh_link;
2509
2510    stab  = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
2511    targ  = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
2512    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
2513                           target_shndx, symtab_shndx ));
2514
2515    for (j = 0; j < nent; j++) {
2516 #if defined(DEBUG) || defined(sparc_TARGET_ARCH) || defined(ia64_TARGET_ARCH)
2517       /* This #ifdef only serves to avoid unused-var warnings. */
2518       Elf_Addr  offset = rtab[j].r_offset;
2519       Elf_Addr  P      = targ + offset;
2520 #endif
2521       Elf_Addr  info   = rtab[j].r_info;
2522       Elf_Addr  A      = rtab[j].r_addend;
2523       Elf_Addr  S;
2524       Elf_Addr  value;
2525 #     if defined(sparc_TARGET_ARCH)
2526       Elf_Word* pP = (Elf_Word*)P;
2527       Elf_Word  w1, w2;
2528 #     elif defined(ia64_TARGET_ARCH)
2529       Elf64_Xword *pP = (Elf64_Xword *)P;
2530       Elf_Addr addr;
2531 #     endif
2532
2533       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p)   ",
2534                              j, (void*)offset, (void*)info,
2535                                 (void*)A ));
2536       if (!info) {
2537          IF_DEBUG(linker,belch( " ZERO" ));
2538          S = 0;
2539       } else {
2540          Elf_Sym sym = stab[ELF_R_SYM(info)];
2541          /* First see if it is a local symbol. */
2542          if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
2543             /* Yes, so we can get the address directly from the ELF symbol
2544                table. */
2545             symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
2546             S = (Elf_Addr)
2547                 (ehdrC + shdr[ sym.st_shndx ].sh_offset
2548                        + stab[ELF_R_SYM(info)].st_value);
2549 #ifdef ELF_FUNCTION_DESC
2550             /* Make a function descriptor for this function */
2551             if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
2552                S = allocateFunctionDesc(S + A);
2553                A = 0;
2554             }
2555 #endif
2556          } else {
2557             /* No, so look up the name in our global table. */
2558             symbol = strtab + sym.st_name;
2559             (void*)S = lookupSymbol( symbol );
2560
2561 #ifdef ELF_FUNCTION_DESC
2562             /* If a function, already a function descriptor - we would
2563                have to copy it to add an offset. */
2564             if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
2565                assert(A == 0);
2566 #endif
2567          }
2568          if (!S) {
2569            belch("%s: unknown symbol `%s'", oc->fileName, symbol);
2570            return 0;
2571          }
2572          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
2573       }
2574
2575       IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n",
2576                                         (void*)P, (void*)S, (void*)A ));
2577       /* checkProddableBlock ( oc, (void*)P ); */
2578
2579       value = S + A;
2580
2581       switch (ELF_R_TYPE(info)) {
2582 #        if defined(sparc_TARGET_ARCH)
2583          case R_SPARC_WDISP30:
2584             w1 = *pP & 0xC0000000;
2585             w2 = (Elf_Word)((value - P) >> 2);
2586             ASSERT((w2 & 0xC0000000) == 0);
2587             w1 |= w2;
2588             *pP = w1;
2589             break;
2590          case R_SPARC_HI22:
2591             w1 = *pP & 0xFFC00000;
2592             w2 = (Elf_Word)(value >> 10);
2593             ASSERT((w2 & 0xFFC00000) == 0);
2594             w1 |= w2;
2595             *pP = w1;
2596             break;
2597          case R_SPARC_LO10:
2598             w1 = *pP & ~0x3FF;
2599             w2 = (Elf_Word)(value & 0x3FF);
2600             ASSERT((w2 & ~0x3FF) == 0);
2601             w1 |= w2;
2602             *pP = w1;
2603             break;
2604          /* According to the Sun documentation:
2605             R_SPARC_UA32
2606             This relocation type resembles R_SPARC_32, except it refers to an
2607             unaligned word. That is, the word to be relocated must be treated
2608             as four separate bytes with arbitrary alignment, not as a word
2609             aligned according to the architecture requirements.
2610
2611             (JRS: which means that freeloading on the R_SPARC_32 case
2612             is probably wrong, but hey ...)
2613          */
2614          case R_SPARC_UA32:
2615          case R_SPARC_32:
2616             w2 = (Elf_Word)value;
2617             *pP = w2;
2618             break;
2619 #        elif defined(ia64_TARGET_ARCH)
2620          case R_IA64_DIR64LSB:
2621          case R_IA64_FPTR64LSB:
2622             *pP = value;
2623             break;
2624          case R_IA64_SEGREL64LSB:
2625             addr = findElfSegment(ehdrC, value);
2626             *pP = value - addr;
2627             break;
2628          case R_IA64_GPREL22:
2629             ia64_reloc_gprel22(P, value);
2630             break;
2631          case R_IA64_LTOFF22:
2632          case R_IA64_LTOFF_FPTR22:
2633             addr = allocateGOTEntry(value);
2634             ia64_reloc_gprel22(P, addr);
2635             break;
2636          case R_IA64_PCREL21B:
2637             ia64_reloc_pcrel21(P, S, oc);
2638             break;
2639 #        endif
2640          default:
2641             belch("%s: unhandled ELF relocation(RelA) type %d\n",
2642                   oc->fileName, ELF_R_TYPE(info));
2643             return 0;
2644       }
2645
2646    }
2647    return 1;
2648 }
2649
2650 static int
2651 ocResolve_ELF ( ObjectCode* oc )
2652 {
2653    char *strtab;
2654    int   shnum, ok;
2655    Elf_Sym*  stab  = NULL;
2656    char*     ehdrC = (char*)(oc->image);
2657    Elf_Ehdr* ehdr  = (Elf_Ehdr*) ehdrC;
2658    Elf_Shdr* shdr  = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2659    char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2660
2661    /* first find "the" symbol table */
2662    stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2663
2664    /* also go find the string table */
2665    strtab = findElfSection ( ehdrC, SHT_STRTAB );
2666
2667    if (stab == NULL || strtab == NULL) {
2668       belch("%s: can't find string or symbol table", oc->fileName);
2669       return 0;
2670    }
2671
2672    /* Process the relocation sections. */
2673    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2674
2675       /* Skip sections called ".rel.stab".  These appear to contain
2676          relocation entries that, when done, make the stabs debugging
2677          info point at the right places.  We ain't interested in all
2678          dat jazz, mun. */
2679       if (0 == memcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name, 9))
2680          continue;
2681
2682       if (shdr[shnum].sh_type == SHT_REL ) {
2683          ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
2684                                        shnum, stab, strtab );
2685          if (!ok) return ok;
2686       }
2687       else
2688       if (shdr[shnum].sh_type == SHT_RELA) {
2689          ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
2690                                         shnum, stab, strtab );
2691          if (!ok) return ok;
2692       }
2693    }
2694
2695    /* Free the local symbol table; we won't need it again. */
2696    freeHashTable(oc->lochash, NULL);
2697    oc->lochash = NULL;
2698
2699    return 1;
2700 }
2701
2702
2703 /*
2704  * IA64 specifics
2705  * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
2706  * at the front.  The following utility functions pack and unpack instructions, and
2707  * take care of the most common relocations.
2708  */
2709
2710 #ifdef ia64_TARGET_ARCH
2711
2712 static Elf64_Xword
2713 ia64_extract_instruction(Elf64_Xword *target)
2714 {
2715    Elf64_Xword w1, w2;
2716    int slot = (Elf_Addr)target & 3;
2717    (Elf_Addr)target &= ~3;
2718
2719    w1 = *target;
2720    w2 = *(target+1);
2721
2722    switch (slot)
2723    {
2724       case 0:
2725          return ((w1 >> 5) & 0x1ffffffffff);
2726       case 1:
2727          return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
2728       case 2:
2729          return (w2 >> 23);
2730       default:
2731          barf("ia64_extract_instruction: invalid slot %p", target);
2732    }
2733 }
2734
2735 static void
2736 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
2737 {
2738    int slot = (Elf_Addr)target & 3;
2739    (Elf_Addr)target &= ~3;
2740
2741    switch (slot)
2742    {
2743       case 0:
2744          *target |= value << 5;
2745          break;
2746       case 1:
2747          *target |= value << 46;
2748          *(target+1) |= value >> 18;
2749          break;
2750       case 2:
2751          *(target+1) |= value << 23;
2752          break;
2753    }
2754 }
2755
2756 static void
2757 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
2758 {
2759    Elf64_Xword instruction;
2760    Elf64_Sxword rel_value;
2761
2762    rel_value = value - gp_val;
2763    if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
2764       barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
2765
2766    instruction = ia64_extract_instruction((Elf64_Xword *)target);
2767    instruction |= (((rel_value >> 0) & 0x07f) << 13)            /* imm7b */
2768                     | (((rel_value >> 7) & 0x1ff) << 27)        /* imm9d */
2769                     | (((rel_value >> 16) & 0x01f) << 22)       /* imm5c */
2770                     | ((Elf64_Xword)(rel_value < 0) << 36);     /* s */
2771    ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2772 }
2773
2774 static void
2775 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
2776 {
2777    Elf64_Xword instruction;
2778    Elf64_Sxword rel_value;
2779    Elf_Addr entry;
2780
2781    entry = allocatePLTEntry(value, oc);
2782
2783    rel_value = (entry >> 4) - (target >> 4);
2784    if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
2785       barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
2786
2787    instruction = ia64_extract_instruction((Elf64_Xword *)target);
2788    instruction |= ((rel_value & 0xfffff) << 13)                 /* imm20b */
2789                     | ((Elf64_Xword)(rel_value < 0) << 36);     /* s */
2790    ia64_deposit_instruction((Elf64_Xword *)target, instruction);
2791 }
2792
2793 #endif /* ia64 */
2794
2795 #endif /* ELF */