ghc/rts/Linker.c

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