ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.42 2001/05/18 21:18:17 qrczak Exp $
   3  *
   4  * (c) The GHC Team, 2000
   5  *
   6  * RTS Object Linker
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "Rts.h"
  11 #include "RtsFlags.h"
  12 #include "HsFFI.h"
  13 #include "Hash.h"
  14 #include "Linker.h"
  15 #include "LinkerInternals.h"
  16 #include "RtsUtils.h"
  17 #include "StoragePriv.h"
  18
  19 #ifdef HAVE_SYS_TYPES_H
  20 #include <sys/types.h>
  21 #endif
  22
  23 #ifdef HAVE_SYS_STAT_H
  24 #include <sys/stat.h>
  25 #endif
  26
  27 #ifdef HAVE_DLFCN_H
  28 #include <dlfcn.h>
  29 #endif
  30
  31 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
  32 #  define OBJFORMAT_ELF
  33 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
  34 #  define OBJFORMAT_PEi386
  35 #  include <windows.h>
  36 #endif
  37
  38 /* Hash table mapping symbol names to Symbol */
  39 /*Str*/HashTable *symhash;
  40
  41 #if defined(OBJFORMAT_ELF)
  42 static int ocVerifyImage_ELF    ( ObjectCode* oc );
  43 static int ocGetNames_ELF       ( ObjectCode* oc );
  44 static int ocResolve_ELF        ( ObjectCode* oc );
  45 #elif defined(OBJFORMAT_PEi386)
  46 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
  47 static int ocGetNames_PEi386    ( ObjectCode* oc );
  48 static int ocResolve_PEi386     ( ObjectCode* oc );
  49 #endif
  50
  51 /* -----------------------------------------------------------------------------
  52  * Built-in symbols from the RTS
  53  */
  54
  55 typedef struct _RtsSymbolVal {
  56     char   *lbl;
  57     void   *addr;
  58 } RtsSymbolVal;
  59
  60
  61 #if !defined(PAR)
  62 #define Maybe_ForeignObj        SymX(mkForeignObjzh_fast)
  63
  64 #define Maybe_Stable_Names      SymX(mkWeakzh_fast)                     \
  65                                 SymX(makeStableNamezh_fast)             \
  66                                 SymX(finalizzeWeakzh_fast)
  67 #else
  68 /* These are not available in GUM!!! -- HWL */
  69 #define Maybe_ForeignObj
  70 #define Maybe_Stable_Names
  71 #endif
  72
  73 #if !defined (mingw32_TARGET_OS)
  74
  75 #define RTS_POSIX_ONLY_SYMBOLS                  \
  76       SymX(stg_sig_install)                     \
  77       Sym(nocldstop)
  78 #define RTS_MINGW_ONLY_SYMBOLS /**/
  79
  80 #else
  81
  82 #define RTS_POSIX_ONLY_SYMBOLS
  83 #define RTS_MINGW_ONLY_SYMBOLS                  \
  84       SymX(abort)                               \
  85       Sym(_alloca)                              \
  86       Sym(isxdigit)                             \
  87       Sym(isupper)                              \
  88       Sym(ispunct)                              \
  89       Sym(islower)                              \
  90       Sym(isspace)                              \
  91       Sym(isprint)                              \
  92       Sym(isdigit)                              \
  93       Sym(iscntrl)                              \
  94       Sym(isalpha)                              \
  95       Sym(isalnum)                              \
  96       SymX(memset)                              \
  97       SymX(strncpy)                             \
  98       SymX(strcpy)                              \
  99       SymX(strcmp)                              \
 100       Sym(mktime)                               \
 101       Sym(gmtime)                               \
 102       Sym(strftime)                             \
 103       Sym(localtime)                            \
 104       SymX(getenv)                              \
 105       SymX(rename)                              \
 106       Sym(opendir)                              \
 107       Sym(readdir)                              \
 108       Sym(closedir)                             \
 109       Sym(PrelHandle_stderr_closure)            \
 110       Sym(Main_main_closure)                    \
 111       Sym(__init_Main)                          \
 112       SymX(pow)                                 \
 113       SymX(tanh)                                \
 114       SymX(cosh)                                \
 115       SymX(sinh)                                \
 116       SymX(atan)                                \
 117       SymX(acos)                                \
 118       SymX(asin)                                \
 119       SymX(tan)                                 \
 120       SymX(cos)                                 \
 121       SymX(sin)                                 \
 122       SymX(exp)                                 \
 123       SymX(log)                                 \
 124       SymX(sqrt)                                \
 125       SymX(Sleep)                               \
 126       SymX(system)                              \
 127       SymX(memchr)                              \
 128       SymX(memcpy)                              \
 129       SymX(memmove)                             \
 130       SymX(fprintf)                             \
 131       Sym(_imp___iob)                           \
 132       Sym(_imp___tzname)                        \
 133       Sym(_imp___timezone)                      \
 134       Sym(__udivdi3)                            \
 135       SymX(GetProcessTimes)                     \
 136       SymX(GetCurrentProcess)                   \
 137       SymX(send)                                \
 138       SymX(recv)                                \
 139       SymX(malloc)                              \
 140       SymX(free)                                \
 141       SymX(realloc)                             \
 142       SymX(_errno)                              \
 143       SymX(closesocket)
 144 #endif
 145
 146
 147 #define RTS_SYMBOLS                             \
 148       SymX(MainRegTable)                        \
 149       Sym(stg_gc_enter_1)                       \
 150       Sym(stg_gc_noregs)                        \
 151       Sym(stg_gc_seq_1)                         \
 152       Sym(stg_gc_d1)                            \
 153       Sym(stg_gc_f1)                            \
 154       Sym(stg_gc_ut_1_0)                        \
 155       Sym(stg_gc_ut_0_1)                        \
 156       Sym(stg_gc_unpt_r1)                       \
 157       Sym(stg_gc_unbx_r1)                       \
 158       Sym(stg_chk_0)                            \
 159       Sym(stg_chk_1)                            \
 160       Sym(stg_gen_chk)                          \
 161       SymX(stg_exit)                            \
 162       SymX(stg_update_PAP)                      \
 163       SymX(stg_ap_1_upd_info)                   \
 164       SymX(stg_ap_2_upd_info)                   \
 165       SymX(stg_ap_3_upd_info)                   \
 166       SymX(stg_ap_4_upd_info)                   \
 167       SymX(stg_ap_5_upd_info)                   \
 168       SymX(stg_ap_6_upd_info)                   \
 169       SymX(stg_ap_7_upd_info)                   \
 170       SymX(stg_ap_8_upd_info)                   \
 171       SymX(stg_sel_0_upd_info)                  \
 172       SymX(stg_sel_1_upd_info)                  \
 173       SymX(stg_sel_2_upd_info)                  \
 174       SymX(stg_sel_3_upd_info)                  \
 175       SymX(stg_sel_4_upd_info)                  \
 176       SymX(stg_sel_5_upd_info)                  \
 177       SymX(stg_sel_6_upd_info)                  \
 178       SymX(stg_sel_7_upd_info)                  \
 179       SymX(stg_sel_8_upd_info)                  \
 180       SymX(stg_sel_9_upd_info)                  \
 181       SymX(stg_sel_10_upd_info)                 \
 182       SymX(stg_sel_11_upd_info)                 \
 183       SymX(stg_sel_12_upd_info)                 \
 184       SymX(stg_sel_13_upd_info)                 \
 185       SymX(stg_sel_14_upd_info)                 \
 186       SymX(stg_sel_15_upd_info)                 \
 187       SymX(stg_upd_frame_info)                  \
 188       SymX(stg_seq_frame_info)                  \
 189       SymX(stg_CAF_BLACKHOLE_info)              \
 190       SymX(stg_IND_STATIC_info)                 \
 191       SymX(stg_EMPTY_MVAR_info)                 \
 192       SymX(stg_MUT_ARR_PTRS_FROZEN_info)        \
 193       SymX(stg_WEAK_info)                       \
 194       SymX(stg_CHARLIKE_closure)                \
 195       SymX(stg_INTLIKE_closure)                 \
 196       SymX(newCAF)                              \
 197       SymX(newBCOzh_fast)                       \
 198       SymX(mkApUpd0zh_fast)                     \
 199       SymX(putMVarzh_fast)                      \
 200       SymX(newMVarzh_fast)                      \
 201       SymX(takeMVarzh_fast)                     \
 202       SymX(tryTakeMVarzh_fast)                  \
 203       SymX(tryPutMVarzh_fast)                   \
 204       SymX(catchzh_fast)                        \
 205       SymX(raisezh_fast)                        \
 206       SymX(forkzh_fast)                         \
 207       SymX(delayzh_fast)                        \
 208       SymX(yieldzh_fast)                        \
 209       SymX(killThreadzh_fast)                   \
 210       SymX(waitReadzh_fast)                     \
 211       SymX(waitWritezh_fast)                    \
 212       SymX(suspendThread)                       \
 213       SymX(resumeThread)                        \
 214       SymX(stackOverflow)                       \
 215       SymX(int2Integerzh_fast)                  \
 216       SymX(word2Integerzh_fast)                 \
 217       Maybe_ForeignObj                          \
 218       SymX(__encodeDouble)                      \
 219       SymX(decodeDoublezh_fast)                 \
 220       SymX(decodeFloatzh_fast)                  \
 221       SymX(gcdIntegerzh_fast)                   \
 222       SymX(newArrayzh_fast)                     \
 223       SymX(unsafeThawArrayzh_fast)              \
 224       SymX(newByteArrayzh_fast)                 \
 225       SymX(newMutVarzh_fast)                    \
 226       SymX(quotRemIntegerzh_fast)               \
 227       SymX(quotIntegerzh_fast)                  \
 228       SymX(remIntegerzh_fast)                   \
 229       SymX(divExactIntegerzh_fast)              \
 230       SymX(divModIntegerzh_fast)                \
 231       SymX(timesIntegerzh_fast)                 \
 232       SymX(minusIntegerzh_fast)                 \
 233       SymX(plusIntegerzh_fast)                  \
 234       SymX(andIntegerzh_fast)                   \
 235       SymX(orIntegerzh_fast)                    \
 236       SymX(xorIntegerzh_fast)                   \
 237       SymX(complementIntegerzh_fast)            \
 238       Maybe_Stable_Names                        \
 239       SymX(blockAsyncExceptionszh_fast)         \
 240       SymX(unblockAsyncExceptionszh_fast)       \
 241       SymX(isDoubleNaN)                         \
 242       SymX(isDoubleInfinite)                    \
 243       SymX(isDoubleDenormalized)                \
 244       SymX(isDoubleNegativeZero)                \
 245       SymX(__encodeFloat)                       \
 246       SymX(isFloatNaN)                          \
 247       SymX(isFloatInfinite)                     \
 248       SymX(isFloatDenormalized)                 \
 249       SymX(isFloatNegativeZero)                 \
 250       SymX(__int_encodeFloat)                   \
 251       SymX(__int_encodeDouble)                  \
 252       SymX(__gmpz_cmp_si)                       \
 253       SymX(__gmpz_cmp_ui)                       \
 254       SymX(__gmpz_cmp)                          \
 255       SymX(__gmpn_gcd_1)                        \
 256       SymX(__gmpz_get_si)                       \
 257       SymX(__gmpz_get_ui)                       \
 258       SymX(prog_argv)                           \
 259       SymX(prog_argc)                           \
 260       SymX(resetNonBlockingFd)                  \
 261       SymX(performGC)                           \
 262       SymX(getStablePtr)                        \
 263       SymX(stable_ptr_table)                    \
 264       SymX(shutdownHaskellAndExit)              \
 265       Sym(stg_enterStackTop)                    \
 266       Sym(stg_yield_to_interpreter)             \
 267       Sym(StgReturn)                            \
 268       Sym(init_stack)                           \
 269       SymX(cmp_thread)                          \
 270       Sym(__init_PrelGHC)                       \
 271       SymX(freeHaskellFunctionPtr)              \
 272       SymX(OnExitHook)                          \
 273       SymX(ErrorHdrHook)                        \
 274       SymX(NoRunnableThreadsHook)               \
 275       SymX(StackOverflowHook)                   \
 276       SymX(OutOfHeapHook)                       \
 277       SymX(MallocFailHook)                      \
 278       SymX(PatErrorHdrHook)                     \
 279       SymX(defaultsHook)                        \
 280       SymX(PreTraceHook)                        \
 281       SymX(PostTraceHook)                       \
 282       SymX(createAdjustor)                      \
 283       SymX(rts_mkChar)                          \
 284       SymX(rts_mkInt)                           \
 285       SymX(rts_mkInt8)                          \
 286       SymX(rts_mkInt16)                         \
 287       SymX(rts_mkInt32)                         \
 288       SymX(rts_mkInt64)                         \
 289       SymX(rts_mkWord)                          \
 290       SymX(rts_mkWord8)                         \
 291       SymX(rts_mkWord16)                        \
 292       SymX(rts_mkWord32)                        \
 293       SymX(rts_mkWord64)                        \
 294       SymX(rts_mkPtr)                           \
 295       SymX(rts_mkFloat)                         \
 296       SymX(rts_mkDouble)                        \
 297       SymX(rts_mkStablePtr)                     \
 298       SymX(rts_mkBool)                          \
 299       SymX(rts_mkString)                        \
 300       SymX(rts_apply)                           \
 301       SymX(rts_mkAddr)                          \
 302       SymX(rts_getChar)                         \
 303       SymX(rts_getInt)                          \
 304       SymX(rts_getInt32)                        \
 305       SymX(rts_getWord)                         \
 306       SymX(rts_getWord32)                       \
 307       SymX(rts_getPtr)                          \
 308       SymX(rts_getFloat)                        \
 309       SymX(rts_getDouble)                       \
 310       SymX(rts_getStablePtr)                    \
 311       SymX(rts_getBool)                         \
 312       SymX(rts_getAddr)                         \
 313       SymX(rts_eval)                            \
 314       SymX(rts_eval_)                           \
 315       SymX(rts_evalIO)                          \
 316       SymX(rts_evalLazyIO)                      \
 317       SymX(rts_checkSchedStatus)
 318
 319 #ifndef SUPPORT_LONG_LONGS
 320 #define RTS_LONG_LONG_SYMS /* nothing */
 321 #else
 322 #define RTS_LONG_LONG_SYMS                      \
 323       SymX(stg_gtWord64)                        \
 324       SymX(stg_geWord64)                        \
 325       SymX(stg_eqWord64)                        \
 326       SymX(stg_neWord64)                        \
 327       SymX(stg_ltWord64)                        \
 328       SymX(stg_leWord64)                        \
 329       SymX(stg_gtInt64)                         \
 330       SymX(stg_geInt64)                         \
 331       SymX(stg_eqInt64)                         \
 332       SymX(stg_neInt64)                         \
 333       SymX(stg_ltInt64)                         \
 334       SymX(stg_leInt64)                         \
 335       SymX(stg_remWord64)                       \
 336       SymX(stg_quotWord64)                      \
 337       SymX(stg_remInt64)                        \
 338       SymX(stg_quotInt64)                       \
 339       SymX(stg_negateInt64)                     \
 340       SymX(stg_plusInt64)                       \
 341       SymX(stg_minusInt64)                      \
 342       SymX(stg_timesInt64)                      \
 343       SymX(stg_and64)                           \
 344       SymX(stg_or64)                            \
 345       SymX(stg_xor64)                           \
 346       SymX(stg_not64)                           \
 347       SymX(stg_shiftL64)                        \
 348       SymX(stg_shiftRL64)                       \
 349       SymX(stg_iShiftL64)                       \
 350       SymX(stg_iShiftRL64)                      \
 351       SymX(stg_iShiftRA64)                      \
 352       SymX(stg_intToInt64)                      \
 353       SymX(stg_int64ToInt)                      \
 354       SymX(stg_int64ToWord64)                   \
 355       SymX(stg_wordToWord64)                    \
 356       SymX(stg_word64ToWord)                    \
 357       SymX(stg_word64ToInt64)                   \
 358       SymX(int64ToIntegerzh_fast)               \
 359       SymX(word64ToIntegerzh_fast)
 360 #endif /* SUPPORT_LONG_LONGS */
 361
 362 /* entirely bogus claims about types of these symbols */
 363 #define Sym(vvv)  extern void (vvv);
 364 #define SymX(vvv) /**/
 365 RTS_SYMBOLS
 366 RTS_LONG_LONG_SYMS
 367 RTS_POSIX_ONLY_SYMBOLS
 368 RTS_MINGW_ONLY_SYMBOLS
 369 #undef Sym
 370 #undef SymX
 371
 372 #ifdef LEADING_UNDERSCORE
 373 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
 374 #else
 375 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
 376 #endif
 377
 378 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
 379                     (void*)(&(vvv)) },
 380 #define SymX(vvv) Sym(vvv)
 381
 382 static RtsSymbolVal rtsSyms[] = {
 383       RTS_SYMBOLS
 384       RTS_LONG_LONG_SYMS
 385       RTS_POSIX_ONLY_SYMBOLS
 386       RTS_MINGW_ONLY_SYMBOLS
 387       { 0, 0 } /* sentinel */
 388 };
 389
 390 /* -----------------------------------------------------------------------------
 391  * initialize the object linker
 392  */
 393 #if defined(OBJFORMAT_ELF)
 394 static void *dl_prog_handle;
 395 #endif
 396
 397 void
 398 initLinker( void )
 399 {
 400     RtsSymbolVal *sym;
 401
 402     symhash = allocStrHashTable();
 403
 404     /* populate the symbol table with stuff from the RTS */
 405     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
 406         insertStrHashTable(symhash, sym->lbl, sym->addr);
 407     }
 408 #   if defined(OBJFORMAT_ELF)
 409     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 410 #   endif
 411 }
 412
 413 /* -----------------------------------------------------------------------------
 414  * Add a DLL from which symbols may be found.  In the ELF case, just
 415  * do RTLD_GLOBAL-style add, so no further messing around needs to
 416  * happen in order that symbols in the loaded .so are findable --
 417  * lookupSymbol() will subsequently see them by dlsym on the program's
 418  * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 419  *
 420  * In the PEi386 case, open the DLLs and put handles to them in a
 421  * linked list.  When looking for a symbol, try all handles in the
 422  * list.
 423  */
 424
 425 #if defined(OBJFORMAT_PEi386)
 426 /* A record for storing handles into DLLs. */
 427
 428 typedef
 429    struct _OpenedDLL {
 430       struct _OpenedDLL* next;
 431       HINSTANCE instance;
 432    }
 433    OpenedDLL;
 434
 435 /* A list thereof. */
 436 static OpenedDLL* opened_dlls = NULL;
 437 #endif
 438
 439
 440
 441 char*
 442 addDLL ( char* dll_name )
 443 {
 444 #  if defined(OBJFORMAT_ELF)
 445    void *hdl;
 446    char *buf;
 447    char *errmsg;
 448
 449    buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
 450    sprintf(buf, "lib%s.so", dll_name);
 451    hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL );
 452    free(buf);
 453    if (hdl == NULL) {
 454       /* dlopen failed; return a ptr to the error msg. */
 455       errmsg = dlerror();
 456       if (errmsg == NULL) errmsg = "addDLL: unknown error";
 457       return errmsg;
 458    } else {
 459       return NULL;
 460    }
 461    ASSERT(0); /*NOTREACHED*/
 462 #  elif defined(OBJFORMAT_PEi386)
 463
 464    /* Add this DLL to the list of DLLs in which to search for symbols.
 465       The first time through, also add the executable to the list,
 466       since we need to search that too. */
 467    char*      buf;
 468    OpenedDLL* o_dll;
 469    HINSTANCE  instance;
 470    /* fprintf(stderr, "addDLL %s\n", dll_name ); */
 471
 472 #if 0
 473    /* Later ... can't figure out why this doesn't work.  So retain the
 474       RTS_MINGW_ONLY_SYMBOLS hack for the time being.  */
 475    if (opened_dlls == NULL) {
 476       /* First time through ... */
 477       instance = GetModuleHandle(NULL);
 478       if (instance == NULL)
 479          return "addDLL: can't get handle to the executable";
 480       o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL-init" );
 481       o_dll->instance = instance;
 482       o_dll->next     = opened_dlls;
 483       opened_dlls     = o_dll;
 484    }
 485 #endif
 486
 487    buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
 488    sprintf(buf, "%s.DLL", dll_name);
 489    instance = LoadLibrary(buf);
 490    free(buf);
 491    if (instance == NULL) {
 492      /* LoadLibrary failed; return a ptr to the error msg. */
 493      return "addDLL: unknown error";
 494    }
 495
 496    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
 497    o_dll->instance = instance;
 498    o_dll->next     = opened_dlls;
 499    opened_dlls     = o_dll;
 500
 501    return NULL;
 502 #  else
 503    barf("addDLL: not implemented on this platform");
 504 #  endif
 505 }
 506
 507 /* -----------------------------------------------------------------------------
 508  * lookup a symbol in the hash table
 509  */
 510 void *
 511 lookupSymbol( char *lbl )
 512 {
 513     void *val;
 514     ASSERT(symhash != NULL);
 515     val = lookupStrHashTable(symhash, lbl);
 516
 517     if (val == NULL) {
 518 #       if defined(OBJFORMAT_ELF)
 519         return dlsym(dl_prog_handle, lbl);
 520 #       elif defined(OBJFORMAT_PEi386)
 521         OpenedDLL* o_dll;
 522         void* sym;
 523         ASSERT(2+2 == 5);
 524         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
 525            sym = GetProcAddress(o_dll->instance, lbl);
 526            if (sym != NULL) return sym;
 527         }
 528         return NULL;
 529 #       endif
 530     } else {
 531         return val;
 532     }
 533 }
 534
 535 static
 536 void *
 537 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 538 {
 539     void *val;
 540     val = lookupStrHashTable(oc->lochash, lbl);
 541
 542     if (val == NULL) {
 543         return NULL;
 544     } else {
 545         return val;
 546     }
 547 }
 548
 549
 550 /* -----------------------------------------------------------------------------
 551  * Load an obj (populate the global symbol table, but don't resolve yet)
 552  *
 553  * Returns: 1 if ok, 0 on error.
 554  */
 555 HsInt
 556 loadObj( char *path )
 557 {
 558    ObjectCode* oc;
 559    struct stat st;
 560    int r, n;
 561    FILE *f;
 562
 563    /* fprintf(stderr, "loadObj %s\n", path ); */
 564 #  ifdef DEBUG
 565    /* assert that we haven't already loaded this object */
 566    {
 567        ObjectCode *o;
 568        for (o = objects; o; o = o->next)
 569            ASSERT(strcmp(o->fileName, path));
 570    }
 571 #  endif /* DEBUG */
 572
 573    oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
 574
 575 #  if defined(OBJFORMAT_ELF)
 576    oc->formatName = "ELF";
 577 #  elif defined(OBJFORMAT_PEi386)
 578    oc->formatName = "PEi386";
 579 #  else
 580    free(oc);
 581    barf("loadObj: not implemented on this platform");
 582 #  endif
 583
 584    r = stat(path, &st);
 585    if (r == -1) { return 0; }
 586
 587    /* sigh, strdup() isn't a POSIX function, so do it the long way */
 588    oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
 589    strcpy(oc->fileName, path);
 590
 591    oc->fileSize          = st.st_size;
 592    oc->image             = stgMallocBytes( st.st_size, "loadObj(image)" );
 593    oc->symbols           = NULL;
 594    oc->sections          = NULL;
 595    oc->lochash           = allocStrHashTable();
 596
 597    /* chain it onto the list of objects */
 598    oc->next              = objects;
 599    objects               = oc;
 600
 601    /* load the image into memory */
 602    f = fopen(path, "rb");
 603    if (!f) {
 604        barf("loadObj: can't read `%s'", path);
 605    }
 606    n = fread ( oc->image, 1, oc->fileSize, f );
 607    if (n != oc->fileSize) {
 608       fclose(f);
 609       barf("loadObj: error whilst reading `%s'", path);
 610    }
 611
 612    /* verify the in-memory image */
 613 #  if defined(OBJFORMAT_ELF)
 614    r = ocVerifyImage_ELF ( oc );
 615 #  elif defined(OBJFORMAT_PEi386)
 616    r = ocVerifyImage_PEi386 ( oc );
 617 #  else
 618    barf("loadObj: no verify method");
 619 #  endif
 620    if (!r) { return r; }
 621
 622    /* build the symbol list for this image */
 623 #  if defined(OBJFORMAT_ELF)
 624    r = ocGetNames_ELF ( oc );
 625 #  elif defined(OBJFORMAT_PEi386)
 626    r = ocGetNames_PEi386 ( oc );
 627 #  else
 628    barf("loadObj: no getNames method");
 629 #  endif
 630    if (!r) { return r; }
 631
 632    /* loaded, but not resolved yet */
 633    oc->status = OBJECT_LOADED;
 634
 635    return 1;
 636 }
 637
 638 /* -----------------------------------------------------------------------------
 639  * resolve all the currently unlinked objects in memory
 640  *
 641  * Returns: 1 if ok, 0 on error.
 642  */
 643 HsInt
 644 resolveObjs( void )
 645 {
 646     ObjectCode *oc;
 647     int r;
 648
 649     for (oc = objects; oc; oc = oc->next) {
 650         if (oc->status != OBJECT_RESOLVED) {
 651 #           if defined(OBJFORMAT_ELF)
 652             r = ocResolve_ELF ( oc );
 653 #           elif defined(OBJFORMAT_PEi386)
 654             r = ocResolve_PEi386 ( oc );
 655 #           else
 656             barf("resolveObjs: not implemented on this platform");
 657 #           endif
 658             if (!r) { return r; }
 659             oc->status = OBJECT_RESOLVED;
 660         }
 661     }
 662     return 1;
 663 }
 664
 665 /* -----------------------------------------------------------------------------
 666  * delete an object from the pool
 667  */
 668 HsInt
 669 unloadObj( char *path )
 670 {
 671     ObjectCode *oc, *prev;
 672
 673     ASSERT(symhash != NULL);
 674     ASSERT(objects != NULL);
 675
 676     prev = NULL;
 677     for (oc = objects; oc; prev = oc, oc = oc->next) {
 678         if (!strcmp(oc->fileName,path)) {
 679
 680             /* Remove all the mappings for the symbols within this
 681              * object..
 682              */
 683             {
 684                 int i;
 685                 for (i = 0; i < oc->n_symbols; i++) {
 686                    if (oc->symbols[i] != NULL) {
 687                        removeStrHashTable(symhash, oc->symbols[i], NULL);
 688                    }
 689                 }
 690             }
 691
 692             if (prev == NULL) {
 693                 objects = oc->next;
 694             } else {
 695                 prev->next = oc->next;
 696             }
 697
 698             /* We're going to leave this in place, in case there are
 699                any pointers from the heap into it: */
 700             /* free(oc->image); */
 701             free(oc->fileName);
 702             free(oc->symbols);
 703             free(oc->sections);
 704             /* The local hash table should have been freed at the end
 705                of the ocResolve_ call on it. */
 706             ASSERT(oc->lochash == NULL);
 707             free(oc);
 708             return 1;
 709         }
 710     }
 711
 712     belch("unloadObj: can't find `%s' to unload", path);
 713     return 0;
 714 }
 715
 716 /* --------------------------------------------------------------------------
 717  * PEi386 specifics (Win32 targets)
 718  * ------------------------------------------------------------------------*/
 719
 720 /* The information for this linker comes from
 721       Microsoft Portable Executable
 722       and Common Object File Format Specification
 723       revision 5.1 January 1998
 724    which SimonM says comes from the MS Developer Network CDs.
 725 */
 726
 727
 728 #if defined(OBJFORMAT_PEi386)
 729
 730
 731
 732 typedef unsigned char  UChar;
 733 typedef unsigned short UInt16;
 734 typedef unsigned int   UInt32;
 735 typedef          int   Int32;
 736
 737
 738 typedef
 739    struct {
 740       UInt16 Machine;
 741       UInt16 NumberOfSections;
 742       UInt32 TimeDateStamp;
 743       UInt32 PointerToSymbolTable;
 744       UInt32 NumberOfSymbols;
 745       UInt16 SizeOfOptionalHeader;
 746       UInt16 Characteristics;
 747    }
 748    COFF_header;
 749
 750 #define sizeof_COFF_header 20
 751
 752
 753 typedef
 754    struct {
 755       UChar  Name[8];
 756       UInt32 VirtualSize;
 757       UInt32 VirtualAddress;
 758       UInt32 SizeOfRawData;
 759       UInt32 PointerToRawData;
 760       UInt32 PointerToRelocations;
 761       UInt32 PointerToLinenumbers;
 762       UInt16 NumberOfRelocations;
 763       UInt16 NumberOfLineNumbers;
 764       UInt32 Characteristics;
 765    }
 766    COFF_section;
 767
 768 #define sizeof_COFF_section 40
 769
 770
 771 typedef
 772    struct {
 773       UChar  Name[8];
 774       UInt32 Value;
 775       UInt16 SectionNumber;
 776       UInt16 Type;
 777       UChar  StorageClass;
 778       UChar  NumberOfAuxSymbols;
 779    }
 780    COFF_symbol;
 781
 782 #define sizeof_COFF_symbol 18
 783
 784
 785 typedef
 786    struct {
 787       UInt32 VirtualAddress;
 788       UInt32 SymbolTableIndex;
 789       UInt16 Type;
 790    }
 791    COFF_reloc;
 792
 793 #define sizeof_COFF_reloc 10
 794
 795
 796 /* From PE spec doc, section 3.3.2 */
 797 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
 798    windows.h -- for the same purpose, but I want to know what I'm
 799    getting, here. */
 800 #define MYIMAGE_FILE_RELOCS_STRIPPED     0x0001
 801 #define MYIMAGE_FILE_EXECUTABLE_IMAGE    0x0002
 802 #define MYIMAGE_FILE_DLL                 0x2000
 803 #define MYIMAGE_FILE_SYSTEM              0x1000
 804 #define MYIMAGE_FILE_BYTES_REVERSED_HI   0x8000
 805 #define MYIMAGE_FILE_BYTES_REVERSED_LO   0x0080
 806 #define MYIMAGE_FILE_32BIT_MACHINE       0x0100
 807
 808 /* From PE spec doc, section 5.4.2 and 5.4.4 */
 809 #define MYIMAGE_SYM_CLASS_EXTERNAL       2
 810 #define MYIMAGE_SYM_CLASS_STATIC         3
 811 #define MYIMAGE_SYM_UNDEFINED            0
 812
 813 /* From PE spec doc, section 4.1 */
 814 #define MYIMAGE_SCN_CNT_CODE             0x00000020
 815 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
 816
 817 /* From PE spec doc, section 5.2.1 */
 818 #define MYIMAGE_REL_I386_DIR32           0x0006
 819 #define MYIMAGE_REL_I386_REL32           0x0014
 820
 821
 822 /* We use myindex to calculate array addresses, rather than
 823    simply doing the normal subscript thing.  That's because
 824    some of the above structs have sizes which are not
 825    a whole number of words.  GCC rounds their sizes up to a
 826    whole number of words, which means that the address calcs
 827    arising from using normal C indexing or pointer arithmetic
 828    are just plain wrong.  Sigh.
 829 */
 830 static UChar *
 831 myindex ( int scale, void* base, int index )
 832 {
 833    return
 834       ((UChar*)base) + scale * index;
 835 }
 836
 837
 838 static void
 839 printName ( UChar* name, UChar* strtab )
 840 {
 841    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 842       UInt32 strtab_offset = * (UInt32*)(name+4);
 843       fprintf ( stderr, "%s", strtab + strtab_offset );
 844    } else {
 845       int i;
 846       for (i = 0; i < 8; i++) {
 847          if (name[i] == 0) break;
 848          fprintf ( stderr, "%c", name[i] );
 849       }
 850    }
 851 }
 852
 853
 854 static void
 855 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
 856 {
 857    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 858       UInt32 strtab_offset = * (UInt32*)(name+4);
 859       strncpy ( dst, strtab+strtab_offset, dstSize );
 860       dst[dstSize-1] = 0;
 861    } else {
 862       int i = 0;
 863       while (1) {
 864          if (i >= 8) break;
 865          if (name[i] == 0) break;
 866          dst[i] = name[i];
 867          i++;
 868       }
 869       dst[i] = 0;
 870    }
 871 }
 872
 873
 874 static UChar *
 875 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
 876 {
 877    UChar* newstr;
 878    /* If the string is longer than 8 bytes, look in the
 879       string table for it -- this will be correctly zero terminated.
 880    */
 881    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 882       UInt32 strtab_offset = * (UInt32*)(name+4);
 883       return ((UChar*)strtab) + strtab_offset;
 884    }
 885    /* Otherwise, if shorter than 8 bytes, return the original,
 886       which by defn is correctly terminated.
 887    */
 888    if (name[7]==0) return name;
 889    /* The annoying case: 8 bytes.  Copy into a temporary
 890       (which is never freed ...)
 891    */
 892    newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
 893    ASSERT(newstr);
 894    strncpy(newstr,name,8);
 895    newstr[8] = 0;
 896    return newstr;
 897 }
 898
 899
 900 /* Just compares the short names (first 8 chars) */
 901 static COFF_section *
 902 findPEi386SectionCalled ( ObjectCode* oc,  char* name )
 903 {
 904    int i;
 905    COFF_header* hdr
 906       = (COFF_header*)(oc->image);
 907    COFF_section* sectab
 908       = (COFF_section*) (
 909            ((UChar*)(oc->image))
 910            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 911         );
 912    for (i = 0; i < hdr->NumberOfSections; i++) {
 913       UChar* n1;
 914       UChar* n2;
 915       COFF_section* section_i
 916          = (COFF_section*)
 917            myindex ( sizeof_COFF_section, sectab, i );
 918       n1 = (UChar*) &(section_i->Name);
 919       n2 = name;
 920       if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
 921           n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
 922           n1[6]==n2[6] && n1[7]==n2[7])
 923          return section_i;
 924    }
 925
 926    return NULL;
 927 }
 928
 929
 930 static void
 931 zapTrailingAtSign ( UChar* sym )
 932 {
 933 #  define my_isdigit(c) ((c) >= '0' && (c) <= '9')
 934    int i, j;
 935    if (sym[0] == 0) return;
 936    i = 0;
 937    while (sym[i] != 0) i++;
 938    i--;
 939    j = i;
 940    while (j > 0 && my_isdigit(sym[j])) j--;
 941    if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
 942 #  undef my_isdigit
 943 }
 944
 945
 946 static int
 947 ocVerifyImage_PEi386 ( ObjectCode* oc )
 948 {
 949    int i, j;
 950    COFF_header*  hdr;
 951    COFF_section* sectab;
 952    COFF_symbol*  symtab;
 953    UChar*        strtab;
 954
 955    hdr = (COFF_header*)(oc->image);
 956    sectab = (COFF_section*) (
 957                ((UChar*)(oc->image))
 958                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 959             );
 960    symtab = (COFF_symbol*) (
 961                ((UChar*)(oc->image))
 962                + hdr->PointerToSymbolTable
 963             );
 964    strtab = ((UChar*)symtab)
 965             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 966
 967    if (hdr->Machine != 0x14c) {
 968       belch("Not x86 PEi386");
 969       return 0;
 970    }
 971    if (hdr->SizeOfOptionalHeader != 0) {
 972       belch("PEi386 with nonempty optional header");
 973       return 0;
 974    }
 975    if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
 976         (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
 977         (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
 978         (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
 979       belch("Not a PEi386 object file");
 980       return 0;
 981    }
 982    if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
 983         /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
 984       belch("Invalid PEi386 word size or endiannness: %d",
 985             (int)(hdr->Characteristics));
 986       return 0;
 987    }
 988    /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
 989    if (* (UInt32*)strtab > 510000) {
 990       belch("PEi386 object has suspiciously large string table; > 64k relocs?");
 991       return 0;
 992    }
 993
 994    /* No further verification after this point; only debug printing. */
 995    i = 0;
 996    IF_DEBUG(linker, i=1);
 997    if (i == 0) return 1;
 998
 999    fprintf ( stderr,
1000              "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1001    fprintf ( stderr,
1002              "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1003    fprintf ( stderr,
1004              "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1005
1006    fprintf ( stderr, "\n" );
1007    fprintf ( stderr,
1008              "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
1009    fprintf ( stderr,
1010              "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
1011    fprintf ( stderr,
1012              "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1013    fprintf ( stderr,
1014              "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
1015    fprintf ( stderr,
1016              "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
1017    fprintf ( stderr,
1018              "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
1019    fprintf ( stderr,
1020              "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
1021
1022    /* Print the section table. */
1023    fprintf ( stderr, "\n" );
1024    for (i = 0; i < hdr->NumberOfSections; i++) {
1025       COFF_reloc* reltab;
1026       COFF_section* sectab_i
1027          = (COFF_section*)
1028            myindex ( sizeof_COFF_section, sectab, i );
1029       fprintf ( stderr,
1030                 "\n"
1031                 "section %d\n"
1032                 "     name `",
1033                 i
1034               );
1035       printName ( sectab_i->Name, strtab );
1036       fprintf ( stderr,
1037                 "'\n"
1038                 "    vsize %d\n"
1039                 "    vaddr %d\n"
1040                 "  data sz %d\n"
1041                 " data off %d\n"
1042                 "  num rel %d\n"
1043                 "  off rel %d\n",
1044                 sectab_i->VirtualSize,
1045                 sectab_i->VirtualAddress,
1046                 sectab_i->SizeOfRawData,
1047                 sectab_i->PointerToRawData,
1048                 sectab_i->NumberOfRelocations,
1049                 sectab_i->PointerToRelocations
1050               );
1051       reltab = (COFF_reloc*) (
1052                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1053                );
1054
1055       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1056          COFF_symbol* sym;
1057          COFF_reloc* rel = (COFF_reloc*)
1058                            myindex ( sizeof_COFF_reloc, reltab, j );
1059          fprintf ( stderr,
1060                    "        type 0x%-4x   vaddr 0x%-8x   name `",
1061                    (UInt32)rel->Type,
1062                    rel->VirtualAddress );
1063          sym = (COFF_symbol*)
1064                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1065          printName ( sym->Name, strtab -10 );
1066          fprintf ( stderr, "'\n" );
1067       }
1068       fprintf ( stderr, "\n" );
1069    }
1070
1071    fprintf ( stderr, "\n" );
1072    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1073    fprintf ( stderr, "---START of string table---\n");
1074    for (i = 4; i < *(Int32*)strtab; i++) {
1075       if (strtab[i] == 0)
1076          fprintf ( stderr, "\n"); else
1077          fprintf( stderr, "%c", strtab[i] );
1078    }
1079    fprintf ( stderr, "--- END  of string table---\n");
1080
1081    fprintf ( stderr, "\n" );
1082    i = 0;
1083    while (1) {
1084       COFF_symbol* symtab_i;
1085       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1086       symtab_i = (COFF_symbol*)
1087                  myindex ( sizeof_COFF_symbol, symtab, i );
1088       fprintf ( stderr,
1089                 "symbol %d\n"
1090                 "     name `",
1091                 i
1092               );
1093       printName ( symtab_i->Name, strtab );
1094       fprintf ( stderr,
1095                 "'\n"
1096                 "    value 0x%x\n"
1097                 "     sec# %d\n"
1098                 "     type 0x%x\n"
1099                 "   sclass 0x%x\n"
1100                 "     nAux %d\n",
1101                 symtab_i->Value,
1102                 (Int32)(symtab_i->SectionNumber) - 1,
1103                 (UInt32)symtab_i->Type,
1104                 (UInt32)symtab_i->StorageClass,
1105                 (UInt32)symtab_i->NumberOfAuxSymbols
1106               );
1107       i += symtab_i->NumberOfAuxSymbols;
1108       i++;
1109    }
1110
1111    fprintf ( stderr, "\n" );
1112    return 1;
1113 }
1114
1115
1116 static int
1117 ocGetNames_PEi386 ( ObjectCode* oc )
1118 {
1119    COFF_header*  hdr;
1120    COFF_section* sectab;
1121    COFF_symbol*  symtab;
1122    UChar*        strtab;
1123
1124    UChar* sname;
1125    void*  addr;
1126    int    i;
1127
1128    hdr = (COFF_header*)(oc->image);
1129    sectab = (COFF_section*) (
1130                ((UChar*)(oc->image))
1131                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1132             );
1133    symtab = (COFF_symbol*) (
1134                ((UChar*)(oc->image))
1135                + hdr->PointerToSymbolTable
1136             );
1137    strtab = ((UChar*)(oc->image))
1138             + hdr->PointerToSymbolTable
1139             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1140
1141    /* Copy exported symbols into the ObjectCode. */
1142
1143    oc->n_symbols = hdr->NumberOfSymbols;
1144    oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
1145                                   "ocGetNames_PEi386(oc->symbols)");
1146    /* Call me paranoid; I don't care. */
1147    for (i = 0; i < oc->n_symbols; i++)
1148       oc->symbols[i] = NULL;
1149
1150    i = 0;
1151    while (1) {
1152       COFF_symbol* symtab_i;
1153       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1154       symtab_i = (COFF_symbol*)
1155                  myindex ( sizeof_COFF_symbol, symtab, i );
1156
1157       if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL &&
1158           symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1159
1160          /* This symbol is global and defined, viz, exported */
1161          COFF_section* sectabent;
1162
1163          /* cstring_from_COFF_symbol_name always succeeds. */
1164          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1165
1166          /* for MYIMAGE_SYMCLASS_EXTERNAL
1167                 && !MYIMAGE_SYM_UNDEFINED,
1168             the address of the symbol is:
1169                 address of relevant section + offset in section
1170          */
1171          sectabent = (COFF_section*)
1172                      myindex ( sizeof_COFF_section,
1173                                sectab,
1174                                symtab_i->SectionNumber-1 );
1175          addr = ((UChar*)(oc->image))
1176                 + (sectabent->PointerToRawData
1177                    + symtab_i->Value);
1178          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1179          ASSERT(i >= 0 && i < oc->n_symbols);
1180          oc->symbols[i] = sname;
1181          insertStrHashTable(symhash, sname, addr);
1182       }
1183       i += symtab_i->NumberOfAuxSymbols;
1184       i++;
1185    }
1186
1187    /* Copy section information into the ObjectCode. */
1188
1189    oc->n_sections = hdr->NumberOfSections;
1190    oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section),
1191                                   "ocGetNamesPEi386" );
1192
1193    for (i = 0; i < oc->n_sections; i++) {
1194       UChar* start;
1195       UChar* end;
1196
1197       SectionKind kind
1198          = SECTIONKIND_OTHER;
1199       COFF_section* sectab_i
1200          = (COFF_section*)
1201            myindex ( sizeof_COFF_section, sectab, i );
1202       IF_DEBUG(linker, belchf("section name = %s\n", sectab_i->Name ));
1203
1204 #if 0
1205       /* I'm sure this is the Right Way to do it.  However, the
1206          alternative of testing the sectab_i->Name field seems to
1207          work ok with Cygwin.
1208       */
1209       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1210           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1211          kind = SECTIONKIND_CODE_OR_RODATA;
1212 #endif
1213
1214       if (0==strcmp(".text",sectab_i->Name))
1215          kind = SECTIONKIND_CODE_OR_RODATA;
1216       if (0==strcmp(".data",sectab_i->Name) ||
1217           0==strcmp(".bss",sectab_i->Name))
1218          kind = SECTIONKIND_RWDATA;
1219
1220       start = ((UChar*)(oc->image))
1221               + sectab_i->PointerToRawData;
1222       end   = start
1223               + sectab_i->SizeOfRawData - 1;
1224
1225       if (kind == SECTIONKIND_OTHER) {
1226          belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1227          return 0;
1228       }
1229
1230       oc->sections[i].start = start;
1231       oc->sections[i].end   = end;
1232       oc->sections[i].kind  = kind;
1233    }
1234
1235    return 1;
1236 }
1237
1238
1239 static int
1240 ocResolve_PEi386 ( ObjectCode* oc )
1241 {
1242    COFF_header*  hdr;
1243    COFF_section* sectab;
1244    COFF_symbol*  symtab;
1245    UChar*        strtab;
1246
1247    UInt32        A;
1248    UInt32        S;
1249    UInt32*       pP;
1250
1251    int i, j;
1252
1253    /* ToDo: should be variable-sized?  But is at least safe in the
1254       sense of buffer-overrun-proof. */
1255    char symbol[1000];
1256    /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1257
1258    hdr = (COFF_header*)(oc->image);
1259    sectab = (COFF_section*) (
1260                ((UChar*)(oc->image))
1261                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1262             );
1263    symtab = (COFF_symbol*) (
1264                ((UChar*)(oc->image))
1265                + hdr->PointerToSymbolTable
1266             );
1267    strtab = ((UChar*)(oc->image))
1268             + hdr->PointerToSymbolTable
1269             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1270
1271    for (i = 0; i < hdr->NumberOfSections; i++) {
1272       COFF_section* sectab_i
1273          = (COFF_section*)
1274            myindex ( sizeof_COFF_section, sectab, i );
1275       COFF_reloc* reltab
1276          = (COFF_reloc*) (
1277               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1278            );
1279       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1280          COFF_symbol* sym;
1281          COFF_reloc* reltab_j
1282             = (COFF_reloc*)
1283               myindex ( sizeof_COFF_reloc, reltab, j );
1284
1285          /* the location to patch */
1286          pP = (UInt32*)(
1287                  ((UChar*)(oc->image))
1288                  + (sectab_i->PointerToRawData
1289                     + reltab_j->VirtualAddress
1290                     - sectab_i->VirtualAddress )
1291               );
1292          /* the existing contents of pP */
1293          A = *pP;
1294          /* the symbol to connect to */
1295          sym = (COFF_symbol*)
1296                myindex ( sizeof_COFF_symbol,
1297                          symtab, reltab_j->SymbolTableIndex );
1298          IF_DEBUG(linker,
1299                   fprintf ( stderr,
1300                             "reloc sec %2d num %3d:  type 0x%-4x   "
1301                             "vaddr 0x%-8x   name `",
1302                             i, j,
1303                             (UInt32)reltab_j->Type,
1304                             reltab_j->VirtualAddress );
1305                             printName ( sym->Name, strtab );
1306                             fprintf ( stderr, "'\n" ));
1307
1308          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1309             COFF_section* section_sym
1310                = findPEi386SectionCalled ( oc, sym->Name );
1311             if (!section_sym) {
1312                fprintf ( stderr, "bad section = `%s'\n", sym->Name );
1313                barf("Can't find abovementioned PEi386 section");
1314                return 0;
1315             }
1316             S = ((UInt32)(oc->image))
1317                 + (section_sym->PointerToRawData
1318                    + sym->Value);
1319          } else {
1320             copyName ( sym->Name, strtab, symbol, 1000-1 );
1321             zapTrailingAtSign ( symbol );
1322             (void*)S = lookupLocalSymbol( oc, symbol );
1323             if ((void*)S == NULL)
1324                (void*)S = lookupSymbol( symbol );
1325             if (S == 0) {
1326                 belch("ocResolve_PEi386: %s: unknown symbol `%s'",
1327                       oc->fileName, symbol);
1328                 return 0;
1329             }
1330          }
1331
1332          switch (reltab_j->Type) {
1333             case MYIMAGE_REL_I386_DIR32:
1334                *pP = A + S;
1335                break;
1336             case MYIMAGE_REL_I386_REL32:
1337                /* Tricky.  We have to insert a displacement at
1338                   pP which, when added to the PC for the _next_
1339                   insn, gives the address of the target (S).
1340                   Problem is to know the address of the next insn
1341                   when we only know pP.  We assume that this
1342                   literal field is always the last in the insn,
1343                   so that the address of the next insn is pP+4
1344                   -- hence the constant 4.
1345                   Also I don't know if A should be added, but so
1346                   far it has always been zero.
1347                */
1348                ASSERT(A==0);
1349                *pP = S - ((UInt32)pP) - 4;
1350                break;
1351             default:
1352                fprintf(stderr,
1353                        "unhandled PEi386 relocation type %d\n",
1354                        reltab_j->Type);
1355                barf("unhandled PEi386 relocation type");
1356                return 0;
1357          }
1358
1359       }
1360    }
1361
1362    /* fprintf(stderr, "completed     %s\n", oc->fileName); */
1363    return 1;
1364 }
1365
1366 #endif /* defined(OBJFORMAT_PEi386) */
1367
1368
1369 /* --------------------------------------------------------------------------
1370  * ELF specifics
1371  * ------------------------------------------------------------------------*/
1372
1373 #if defined(OBJFORMAT_ELF)
1374
1375 #define FALSE 0
1376 #define TRUE  1
1377
1378 #if defined(sparc_TARGET_ARCH)
1379 #  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
1380 #endif
1381
1382 #include <elf.h>
1383
1384 static char *
1385 findElfSection ( void* objImage, Elf32_Word sh_type )
1386 {
1387    int i;
1388    char* ehdrC = (char*)objImage;
1389    Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1390    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1391    char* ptr = NULL;
1392    for (i = 0; i < ehdr->e_shnum; i++) {
1393       if (shdr[i].sh_type == sh_type &&
1394           i !=  ehdr->e_shstrndx) {
1395          ptr = ehdrC + shdr[i].sh_offset;
1396          break;
1397       }
1398    }
1399    return ptr;
1400 }
1401
1402
1403 static int
1404 ocVerifyImage_ELF ( ObjectCode* oc )
1405 {
1406    Elf32_Shdr* shdr;
1407    Elf32_Sym*  stab;
1408    int i, j, nent, nstrtab, nsymtabs;
1409    char* sh_strtab;
1410    char* strtab;
1411
1412    char*       ehdrC = (char*)(oc->image);
1413    Elf32_Ehdr* ehdr  = ( Elf32_Ehdr*)ehdrC;
1414
1415    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1416        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1417        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1418        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1419       belch("ocVerifyImage_ELF: not an ELF header");
1420       return 0;
1421    }
1422    IF_DEBUG(linker,belch( "Is an ELF header" ));
1423
1424    if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1425       belch("ocVerifyImage_ELF: not 32 bit ELF" );
1426       return 0;
1427    }
1428
1429    IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1430
1431    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1432        IF_DEBUG(linker,belch( "Is little-endian" ));
1433    } else
1434    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1435        IF_DEBUG(linker,belch( "Is big-endian" ));
1436    } else {
1437        belch("ocVerifyImage_ELF: unknown endiannness");
1438        return 0;
1439    }
1440
1441    if (ehdr->e_type != ET_REL) {
1442       belch("ocVerifyImage_ELF: not a relocatable object (.o) file");
1443       return 0;
1444    }
1445    IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1446
1447    IF_DEBUG(linker,belch( "Architecture is " ));
1448    switch (ehdr->e_machine) {
1449       case EM_386:   IF_DEBUG(linker,belch( "x86" )); break;
1450       case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1451       default:       IF_DEBUG(linker,belch( "unknown" ));
1452                      belch("ocVerifyImage_ELF: unknown architecture");
1453                      return 0;
1454    }
1455
1456    IF_DEBUG(linker,belch(
1457              "\nSection header table: start %d, n_entries %d, ent_size %d",
1458              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
1459
1460    ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1461
1462    shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1463
1464    if (ehdr->e_shstrndx == SHN_UNDEF) {
1465       belch("ocVerifyImage_ELF: no section header string table");
1466       return 0;
1467    } else {
1468       IF_DEBUG(linker,belch( "Section header string table is section %d",
1469                           ehdr->e_shstrndx));
1470       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1471    }
1472
1473    for (i = 0; i < ehdr->e_shnum; i++) {
1474       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
1475       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", (int)shdr[i].sh_type ));
1476       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", (int)shdr[i].sh_size ));
1477       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", (int)shdr[i].sh_offset ));
1478       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
1479                ehdrC + shdr[i].sh_offset,
1480                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1481
1482       if (shdr[i].sh_type == SHT_REL) {
1483           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
1484       } else if (shdr[i].sh_type == SHT_RELA) {
1485           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1486       } else {
1487           IF_DEBUG(linker,fprintf(stderr,"     "));
1488       }
1489       if (sh_strtab) {
1490           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1491       }
1492    }
1493
1494    IF_DEBUG(linker,belch( "\nString tables" ));
1495    strtab = NULL;
1496    nstrtab = 0;
1497    for (i = 0; i < ehdr->e_shnum; i++) {
1498       if (shdr[i].sh_type == SHT_STRTAB &&
1499           i !=  ehdr->e_shstrndx) {
1500           IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
1501          strtab = ehdrC + shdr[i].sh_offset;
1502          nstrtab++;
1503       }
1504    }
1505    if (nstrtab != 1) {
1506       belch("ocVerifyImage_ELF: no string tables, or too many");
1507       return 0;
1508    }
1509
1510    nsymtabs = 0;
1511    IF_DEBUG(linker,belch( "\nSymbol tables" ));
1512    for (i = 0; i < ehdr->e_shnum; i++) {
1513       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1514       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1515       nsymtabs++;
1516       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1517       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1518       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
1519                nent,
1520                shdr[i].sh_size % sizeof(Elf32_Sym)
1521              ));
1522       if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1523          belch("ocVerifyImage_ELF: non-integral number of symbol table entries");
1524          return 0;
1525       }
1526       for (j = 0; j < nent; j++) {
1527          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
1528          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ",
1529                              (int)stab[j].st_shndx,
1530                              (int)stab[j].st_size,
1531                              (char*)stab[j].st_value ));
1532
1533          IF_DEBUG(linker,fprintf(stderr, "type=" ));
1534          switch (ELF32_ST_TYPE(stab[j].st_info)) {
1535             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1536             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1537             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
1538             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1539             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
1540             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
1541          }
1542          IF_DEBUG(linker,fprintf(stderr, "  " ));
1543
1544          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1545          switch (ELF32_ST_BIND(stab[j].st_info)) {
1546             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1547             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1548             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
1549             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
1550          }
1551          IF_DEBUG(linker,fprintf(stderr, "  " ));
1552
1553          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1554       }
1555    }
1556
1557    if (nsymtabs == 0) {
1558       belch("ocVerifyImage_ELF: didn't find any symbol tables");
1559       return 0;
1560    }
1561
1562    return 1;
1563 }
1564
1565
1566 static int
1567 ocGetNames_ELF ( ObjectCode* oc )
1568 {
1569    int i, j, k, nent;
1570    Elf32_Sym* stab;
1571
1572    char*       ehdrC      = (char*)(oc->image);
1573    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
1574    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
1575    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1576    char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1577
1578    ASSERT(symhash != NULL);
1579
1580    if (!strtab) {
1581       belch("ocGetNames_ELF: no strtab");
1582       return 0;
1583    }
1584
1585    k = 0;
1586    oc->n_sections = ehdr->e_shnum;
1587    oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section),
1588                                   "ocGetNames_ELF(oc->sections)" );
1589
1590    for (i = 0; i < oc->n_sections; i++) {
1591
1592       /* make a section entry for relevant sections */
1593       SectionKind kind = SECTIONKIND_OTHER;
1594       if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
1595           !strcmp(".data1",sh_strtab+shdr[i].sh_name))
1596           kind = SECTIONKIND_RWDATA;
1597       if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
1598           !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
1599           !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
1600           kind = SECTIONKIND_CODE_OR_RODATA;
1601
1602       /* fill in the section info */
1603       oc->sections[i].start = ehdrC + shdr[i].sh_offset;
1604       oc->sections[i].end   = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
1605       oc->sections[i].kind  = kind;
1606
1607       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1608
1609       /* copy stuff into this module's object symbol table */
1610       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1611       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1612
1613       oc->n_symbols = nent;
1614       oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1615                                    "ocGetNames_ELF(oc->symbols)");
1616
1617       for (j = 0; j < nent; j++) {
1618          if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1619                 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1620               )
1621               /* and not an undefined symbol */
1622               && stab[j].st_shndx != SHN_UNDEF
1623               /* and not in a "special section" */
1624               && stab[j].st_shndx < SHN_LORESERVE
1625               &&
1626               /* and it's a not a section or string table or anything silly */
1627               ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1628                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1629                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE
1630               )
1631             ) {
1632             char* nm = strtab + stab[j].st_name;
1633             char* ad = ehdrC
1634                        + shdr[ stab[j].st_shndx ].sh_offset
1635                        + stab[j].st_value;
1636             ASSERT(nm != NULL);
1637             ASSERT(ad != NULL);
1638             oc->symbols[j] = nm;
1639             if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
1640                IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p  %s %s",
1641                                       ad, oc->fileName, nm ));
1642                insertStrHashTable(oc->lochash, nm, ad);
1643             } else {
1644                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
1645                                       ad, oc->fileName, nm ));
1646                insertStrHashTable(symhash, nm, ad);
1647             }
1648          }
1649          else {
1650             IF_DEBUG(linker,belch( "skipping `%s'",
1651                                    strtab + stab[j].st_name ));
1652             /*
1653             fprintf(stderr,
1654                     "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
1655                     (int)ELF32_ST_BIND(stab[j].st_info),
1656                     (int)ELF32_ST_TYPE(stab[j].st_info),
1657                     (int)stab[j].st_shndx,
1658                     strtab + stab[j].st_name
1659                    );
1660             */
1661             oc->symbols[j] = NULL;
1662          }
1663       }
1664    }
1665
1666    return 1;
1667 }
1668
1669
1670 /* Do ELF relocations which lack an explicit addend.  All x86-linux
1671    relocations appear to be of this form. */
1672 static int do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
1673                                       Elf32_Shdr* shdr, int shnum,
1674                                       Elf32_Sym*  stab, char* strtab )
1675 {
1676    int j;
1677    char *symbol;
1678    Elf32_Word* targ;
1679    Elf32_Rel*  rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset);
1680    int         nent = shdr[shnum].sh_size / sizeof(Elf32_Rel);
1681    int target_shndx = shdr[shnum].sh_info;
1682    int symtab_shndx = shdr[shnum].sh_link;
1683    stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1684    targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1685    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1686                           target_shndx, symtab_shndx ));
1687    for (j = 0; j < nent; j++) {
1688       Elf32_Addr offset = rtab[j].r_offset;
1689       Elf32_Word info   = rtab[j].r_info;
1690
1691       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
1692       Elf32_Word* pP = (Elf32_Word*)P;
1693       Elf32_Addr  A  = *pP;
1694       Elf32_Addr  S;
1695
1696       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
1697                              j, (void*)offset, (void*)info ));
1698       if (!info) {
1699          IF_DEBUG(linker,belch( " ZERO" ));
1700          S = 0;
1701       } else {
1702          /* First see if it is a nameless local symbol. */
1703          if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1704             symbol = "(noname)";
1705             S = (Elf32_Addr)
1706                 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1707                        + stab[ELF32_R_SYM(info)].st_value);
1708          } else {
1709             /* No?  Should be in a symbol table then; first try the
1710                local one. */
1711             symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1712             (void*)S = lookupLocalSymbol( oc, symbol );
1713             if ((void*)S == NULL)
1714                (void*)S = lookupSymbol( symbol );
1715          }
1716          if (!S) {
1717             barf("do_Elf32_Rel_relocations:  %s: unknown symbol `%s'",
1718                  oc->fileName, symbol);
1719          }
1720          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1721       }
1722       IF_DEBUG(linker,belch( "Reloc: P = %p   S = %p   A = %p",
1723                              (void*)P, (void*)S, (void*)A ));
1724       switch (ELF32_R_TYPE(info)) {
1725 #        ifdef i386_TARGET_ARCH
1726          case R_386_32:   *pP = S + A;     break;
1727          case R_386_PC32: *pP = S + A - P; break;
1728 #        endif
1729          default:
1730             fprintf(stderr, "unhandled ELF relocation(Rel) type %d\n",
1731                             ELF32_R_TYPE(info));
1732             barf("do_Elf32_Rel_relocations: unhandled ELF relocation type");
1733             return 0;
1734       }
1735
1736    }
1737    return 1;
1738 }
1739
1740
1741 /* Do ELF relocations for which explicit addends are supplied.
1742    sparc-solaris relocations appear to be of this form. */
1743 static int do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
1744                                        Elf32_Shdr* shdr, int shnum,
1745                                        Elf32_Sym*  stab, char* strtab )
1746 {
1747    int j;
1748    char *symbol;
1749    Elf32_Word* targ;
1750    Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset);
1751    int         nent = shdr[shnum].sh_size / sizeof(Elf32_Rela);
1752    int target_shndx = shdr[shnum].sh_info;
1753    int symtab_shndx = shdr[shnum].sh_link;
1754    stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1755    targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1756    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1757                           target_shndx, symtab_shndx ));
1758    for (j = 0; j < nent; j++) {
1759       Elf32_Addr  offset = rtab[j].r_offset;
1760       Elf32_Word  info   = rtab[j].r_info;
1761       Elf32_Sword addend = rtab[j].r_addend;
1762
1763       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
1764       Elf32_Addr  A  = addend;
1765       Elf32_Addr  S;
1766 #     if defined(sparc_TARGET_ARCH)
1767       /* This #ifdef only serves to avoid unused-var warnings. */
1768       Elf32_Word* pP = (Elf32_Word*)P;
1769       Elf32_Word  w1, w2;
1770 #     endif
1771
1772       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p)   ",
1773                              j, (void*)offset, (void*)info,
1774                                 (void*)addend ));
1775       if (!info) {
1776          IF_DEBUG(linker,belch( " ZERO" ));
1777          S = 0;
1778       } else {
1779          /* First see if it is a nameless local symbol. */
1780          if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1781             symbol = "(noname)";
1782             S = (Elf32_Addr)
1783                 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1784                        + stab[ELF32_R_SYM(info)].st_value);
1785          } else {
1786             /* No?  Should be in a symbol table then; first try the
1787                local one. */
1788             symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1789             (void*)S = lookupLocalSymbol( oc, symbol );
1790             if ((void*)S == NULL)
1791                (void*)S = lookupSymbol( symbol );
1792          }
1793          if (!S) {
1794            barf("do_Elf32_Rela_relocations: %s: unknown symbol `%s'",
1795                    oc->fileName, symbol);
1796            /*
1797            S = 0x11223344;
1798            fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
1799            */
1800          }
1801          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1802       }
1803       IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n",
1804                                         (void*)P, (void*)S, (void*)A ));
1805       switch (ELF32_R_TYPE(info)) {
1806 #        if defined(sparc_TARGET_ARCH)
1807          case R_SPARC_WDISP30:
1808             w1 = *pP & 0xC0000000;
1809             w2 = (Elf32_Word)((S + A - P) >> 2);
1810             ASSERT((w2 & 0xC0000000) == 0);
1811             w1 |= w2;
1812             *pP = w1;
1813             break;
1814          case R_SPARC_HI22:
1815             w1 = *pP & 0xFFC00000;
1816             w2 = (Elf32_Word)((S + A) >> 10);
1817             ASSERT((w2 & 0xFFC00000) == 0);
1818             w1 |= w2;
1819             *pP = w1;
1820             break;
1821          case R_SPARC_LO10:
1822             w1 = *pP & ~0x3FF;
1823             w2 = (Elf32_Word)((S + A) & 0x3FF);
1824             ASSERT((w2 & ~0x3FF) == 0);
1825             w1 |= w2;
1826             *pP = w1;
1827             break;
1828          case R_SPARC_32:
1829             w2 = (Elf32_Word)(S + A);
1830             *pP = w2;
1831             break;
1832 #        endif
1833          default:
1834             fprintf(stderr, "unhandled ELF relocation(RelA) type %d\n",
1835                             ELF32_R_TYPE(info));
1836             barf("do_Elf32_Rela_relocations: unhandled ELF relocation type");
1837             return 0;
1838       }
1839
1840    }
1841    return 1;
1842 }
1843
1844
1845 static int
1846 ocResolve_ELF ( ObjectCode* oc )
1847 {
1848    char *strtab;
1849    int   shnum, ok;
1850    Elf32_Sym*  stab = NULL;
1851    char*       ehdrC = (char*)(oc->image);
1852    Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
1853    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1854
1855    /* first find "the" symbol table */
1856    stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
1857
1858    /* also go find the string table */
1859    strtab = findElfSection ( ehdrC, SHT_STRTAB );
1860
1861    if (stab == NULL || strtab == NULL) {
1862       belch("ocResolve_ELF: can't find string or symbol table");
1863       return 0;
1864    }
1865
1866    /* Process the relocation sections. */
1867    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
1868       if (shdr[shnum].sh_type == SHT_REL ) {
1869          ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
1870                                          shnum, stab, strtab );
1871          if (!ok) return ok;
1872       }
1873       else
1874       if (shdr[shnum].sh_type == SHT_RELA) {
1875          ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
1876                                           shnum, stab, strtab );
1877          if (!ok) return ok;
1878       }
1879    }
1880
1881    /* Free the local symbol table; we won't need it again. */
1882    freeHashTable(oc->lochash, NULL);
1883    oc->lochash = NULL;
1884
1885    return 1;
1886 }
1887
1888
1889 #endif /* ELF */