ghc/rts/Linker.c

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