ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.55 2001/08/10 08:24:38 simonmar 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
  84 /* These are statically linked from the mingw libraries into the ghc
  85    executable, so we have to employ this hack. */
  86 #define RTS_MINGW_ONLY_SYMBOLS                  \
  87       SymX(memset)                              \
  88       SymX(inet_ntoa)                           \
  89       SymX(inet_addr)                           \
  90       SymX(htonl)                               \
  91       SymX(recvfrom)                            \
  92       SymX(listen)                              \
  93       SymX(bind)                                \
  94       SymX(shutdown)                            \
  95       SymX(connect)                             \
  96       SymX(htons)                               \
  97       SymX(ntohs)                               \
  98       SymX(getservbyname)                       \
  99       SymX(getservbyport)                       \
 100       SymX(getprotobynumber)                    \
 101       SymX(getprotobyname)                      \
 102       SymX(gethostbyname)                       \
 103       SymX(gethostbyaddr)                       \
 104       SymX(gethostname)                         \
 105       SymX(strcpy)                              \
 106       SymX(strncpy)                             \
 107       SymX(abort)                               \
 108       Sym(_alloca)                              \
 109       Sym(isxdigit)                             \
 110       Sym(isupper)                              \
 111       Sym(ispunct)                              \
 112       Sym(islower)                              \
 113       Sym(isspace)                              \
 114       Sym(isprint)                              \
 115       Sym(isdigit)                              \
 116       Sym(iscntrl)                              \
 117       Sym(isalpha)                              \
 118       Sym(isalnum)                              \
 119       SymX(strcmp)                              \
 120       SymX(memmove)                             \
 121       SymX(realloc)                             \
 122       SymX(malloc)                              \
 123       SymX(pow)                                 \
 124       SymX(tanh)                                \
 125       SymX(cosh)                                \
 126       SymX(sinh)                                \
 127       SymX(atan)                                \
 128       SymX(acos)                                \
 129       SymX(asin)                                \
 130       SymX(tan)                                 \
 131       SymX(cos)                                 \
 132       SymX(sin)                                 \
 133       SymX(exp)                                 \
 134       SymX(log)                                 \
 135       SymX(sqrt)                                \
 136       SymX(memcpy)                              \
 137       Sym(mktime)                               \
 138       Sym(_imp___timezone)                      \
 139       Sym(_imp___tzname)                        \
 140       Sym(localtime)                            \
 141       Sym(gmtime)                               \
 142       SymX(getenv)                              \
 143       SymX(free)                                \
 144       SymX(rename)                              \
 145       Sym(opendir)                              \
 146       Sym(readdir)                              \
 147       Sym(closedir)                             \
 148       SymX(GetCurrentProcess)                   \
 149       SymX(GetProcessTimes)                     \
 150       SymX(CloseHandle)                         \
 151       SymX(GetExitCodeProcess)                  \
 152       SymX(WaitForSingleObject)                 \
 153       SymX(CreateProcessA)                      \
 154       Sym(__divdi3)                             \
 155       Sym(__udivdi3)                            \
 156       Sym(__moddi3)                             \
 157       Sym(__umoddi3)                            \
 158       SymX(_errno)
 159 #endif
 160
 161
 162 #define RTS_SYMBOLS                             \
 163       SymX(MainRegTable)                        \
 164       Sym(stg_gc_enter_1)                       \
 165       Sym(stg_gc_noregs)                        \
 166       Sym(stg_gc_seq_1)                         \
 167       Sym(stg_gc_d1)                            \
 168       Sym(stg_gc_f1)                            \
 169       Sym(stg_gc_ut_1_0)                        \
 170       Sym(stg_gc_ut_0_1)                        \
 171       Sym(stg_gc_unpt_r1)                       \
 172       Sym(stg_gc_unbx_r1)                       \
 173       Sym(stg_chk_0)                            \
 174       Sym(stg_chk_1)                            \
 175       Sym(stg_gen_chk)                          \
 176       SymX(stg_exit)                            \
 177       SymX(stg_update_PAP)                      \
 178       SymX(stg_ap_1_upd_info)                   \
 179       SymX(stg_ap_2_upd_info)                   \
 180       SymX(stg_ap_3_upd_info)                   \
 181       SymX(stg_ap_4_upd_info)                   \
 182       SymX(stg_ap_5_upd_info)                   \
 183       SymX(stg_ap_6_upd_info)                   \
 184       SymX(stg_ap_7_upd_info)                   \
 185       SymX(stg_ap_8_upd_info)                   \
 186       SymX(stg_sel_0_upd_info)                  \
 187       SymX(stg_sel_1_upd_info)                  \
 188       SymX(stg_sel_2_upd_info)                  \
 189       SymX(stg_sel_3_upd_info)                  \
 190       SymX(stg_sel_4_upd_info)                  \
 191       SymX(stg_sel_5_upd_info)                  \
 192       SymX(stg_sel_6_upd_info)                  \
 193       SymX(stg_sel_7_upd_info)                  \
 194       SymX(stg_sel_8_upd_info)                  \
 195       SymX(stg_sel_9_upd_info)                  \
 196       SymX(stg_sel_10_upd_info)                 \
 197       SymX(stg_sel_11_upd_info)                 \
 198       SymX(stg_sel_12_upd_info)                 \
 199       SymX(stg_sel_13_upd_info)                 \
 200       SymX(stg_sel_14_upd_info)                 \
 201       SymX(stg_sel_15_upd_info)                 \
 202       SymX(stg_upd_frame_info)                  \
 203       SymX(stg_seq_frame_info)                  \
 204       SymX(stg_CAF_BLACKHOLE_info)              \
 205       SymX(stg_IND_STATIC_info)                 \
 206       SymX(stg_EMPTY_MVAR_info)                 \
 207       SymX(stg_MUT_ARR_PTRS_FROZEN_info)        \
 208       SymX(stg_WEAK_info)                       \
 209       SymX(stg_CHARLIKE_closure)                \
 210       SymX(stg_INTLIKE_closure)                 \
 211       SymX(newCAF)                              \
 212       SymX(newBCOzh_fast)                       \
 213       SymX(mkApUpd0zh_fast)                     \
 214       SymX(putMVarzh_fast)                      \
 215       SymX(newMVarzh_fast)                      \
 216       SymX(takeMVarzh_fast)                     \
 217       SymX(tryTakeMVarzh_fast)                  \
 218       SymX(tryPutMVarzh_fast)                   \
 219       SymX(catchzh_fast)                        \
 220       SymX(raisezh_fast)                        \
 221       SymX(forkzh_fast)                         \
 222       SymX(delayzh_fast)                        \
 223       SymX(yieldzh_fast)                        \
 224       SymX(killThreadzh_fast)                   \
 225       SymX(waitReadzh_fast)                     \
 226       SymX(waitWritezh_fast)                    \
 227       SymX(suspendThread)                       \
 228       SymX(resumeThread)                        \
 229       SymX(stackOverflow)                       \
 230       SymX(int2Integerzh_fast)                  \
 231       SymX(word2Integerzh_fast)                 \
 232       Maybe_ForeignObj                          \
 233       SymX(__encodeDouble)                      \
 234       SymX(decodeDoublezh_fast)                 \
 235       SymX(decodeFloatzh_fast)                  \
 236       SymX(gcdIntegerzh_fast)                   \
 237       SymX(newArrayzh_fast)                     \
 238       SymX(unsafeThawArrayzh_fast)              \
 239       SymX(newByteArrayzh_fast)                 \
 240       SymX(newPinnedByteArrayzh_fast)           \
 241       SymX(newMutVarzh_fast)                    \
 242       SymX(quotRemIntegerzh_fast)               \
 243       SymX(quotIntegerzh_fast)                  \
 244       SymX(remIntegerzh_fast)                   \
 245       SymX(divExactIntegerzh_fast)              \
 246       SymX(divModIntegerzh_fast)                \
 247       SymX(timesIntegerzh_fast)                 \
 248       SymX(minusIntegerzh_fast)                 \
 249       SymX(plusIntegerzh_fast)                  \
 250       SymX(andIntegerzh_fast)                   \
 251       SymX(orIntegerzh_fast)                    \
 252       SymX(xorIntegerzh_fast)                   \
 253       SymX(complementIntegerzh_fast)            \
 254       Maybe_Stable_Names                        \
 255       SymX(blockAsyncExceptionszh_fast)         \
 256       SymX(unblockAsyncExceptionszh_fast)       \
 257       SymX(isDoubleNaN)                         \
 258       SymX(isDoubleInfinite)                    \
 259       SymX(isDoubleDenormalized)                \
 260       SymX(isDoubleNegativeZero)                \
 261       SymX(__encodeFloat)                       \
 262       SymX(isFloatNaN)                          \
 263       SymX(isFloatInfinite)                     \
 264       SymX(isFloatDenormalized)                 \
 265       SymX(isFloatNegativeZero)                 \
 266       SymX(__int_encodeFloat)                   \
 267       SymX(__int_encodeDouble)                  \
 268       SymX(__gmpz_cmp_si)                       \
 269       SymX(__gmpz_cmp_ui)                       \
 270       SymX(__gmpz_cmp)                          \
 271       SymX(__gmpn_gcd_1)                        \
 272       SymX(__gmpz_get_si)                       \
 273       SymX(__gmpz_get_ui)                       \
 274       SymX(prog_argv)                           \
 275       SymX(prog_argc)                           \
 276       SymX(resetNonBlockingFd)                  \
 277       SymX(performGC)                           \
 278       SymX(getStablePtr)                        \
 279       SymX(stable_ptr_table)                    \
 280       SymX(shutdownHaskellAndExit)              \
 281       Sym(stg_enterStackTop)                    \
 282       Sym(stg_yield_to_interpreter)             \
 283       Sym(StgReturn)                            \
 284       Sym(init_stack)                           \
 285       SymX(cmp_thread)                          \
 286       Sym(__init_PrelGHC)                       \
 287       SymX(freeHaskellFunctionPtr)              \
 288       SymX(OnExitHook)                          \
 289       SymX(ErrorHdrHook)                        \
 290       SymX(NoRunnableThreadsHook)               \
 291       SymX(StackOverflowHook)                   \
 292       SymX(OutOfHeapHook)                       \
 293       SymX(MallocFailHook)                      \
 294       SymX(PatErrorHdrHook)                     \
 295       SymX(defaultsHook)                        \
 296       SymX(PreTraceHook)                        \
 297       SymX(PostTraceHook)                       \
 298       SymX(createAdjustor)                      \
 299       SymX(rts_mkChar)                          \
 300       SymX(rts_mkInt)                           \
 301       SymX(rts_mkInt8)                          \
 302       SymX(rts_mkInt16)                         \
 303       SymX(rts_mkInt32)                         \
 304       SymX(rts_mkInt64)                         \
 305       SymX(rts_mkWord)                          \
 306       SymX(rts_mkWord8)                         \
 307       SymX(rts_mkWord16)                        \
 308       SymX(rts_mkWord32)                        \
 309       SymX(rts_mkWord64)                        \
 310       SymX(rts_mkPtr)                           \
 311       SymX(rts_mkFloat)                         \
 312       SymX(rts_mkDouble)                        \
 313       SymX(rts_mkStablePtr)                     \
 314       SymX(rts_mkBool)                          \
 315       SymX(rts_mkString)                        \
 316       SymX(rts_apply)                           \
 317       SymX(rts_mkAddr)                          \
 318       SymX(rts_getChar)                         \
 319       SymX(rts_getInt)                          \
 320       SymX(rts_getInt32)                        \
 321       SymX(rts_getWord)                         \
 322       SymX(rts_getWord32)                       \
 323       SymX(rts_getPtr)                          \
 324       SymX(rts_getFloat)                        \
 325       SymX(rts_getDouble)                       \
 326       SymX(rts_getStablePtr)                    \
 327       SymX(rts_getBool)                         \
 328       SymX(rts_getAddr)                         \
 329       SymX(rts_eval)                            \
 330       SymX(rts_eval_)                           \
 331       SymX(rts_evalIO)                          \
 332       SymX(rts_evalLazyIO)                      \
 333       SymX(rts_checkSchedStatus)
 334
 335 #ifndef SUPPORT_LONG_LONGS
 336 #define RTS_LONG_LONG_SYMS /* nothing */
 337 #else
 338 #define RTS_LONG_LONG_SYMS                      \
 339       SymX(int64ToIntegerzh_fast)               \
 340       SymX(word64ToIntegerzh_fast)
 341 #endif /* SUPPORT_LONG_LONGS */
 342
 343 /* entirely bogus claims about types of these symbols */
 344 #define Sym(vvv)  extern void (vvv);
 345 #define SymX(vvv) /**/
 346 RTS_SYMBOLS
 347 RTS_LONG_LONG_SYMS
 348 RTS_POSIX_ONLY_SYMBOLS
 349 RTS_MINGW_ONLY_SYMBOLS
 350 #undef Sym
 351 #undef SymX
 352
 353 #ifdef LEADING_UNDERSCORE
 354 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
 355 #else
 356 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
 357 #endif
 358
 359 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
 360                     (void*)(&(vvv)) },
 361 #define SymX(vvv) Sym(vvv)
 362
 363 static RtsSymbolVal rtsSyms[] = {
 364       RTS_SYMBOLS
 365       RTS_LONG_LONG_SYMS
 366       RTS_POSIX_ONLY_SYMBOLS
 367       RTS_MINGW_ONLY_SYMBOLS
 368       { 0, 0 } /* sentinel */
 369 };
 370
 371 /* -----------------------------------------------------------------------------
 372  * initialize the object linker
 373  */
 374 #if defined(OBJFORMAT_ELF)
 375 static void *dl_prog_handle;
 376 #endif
 377
 378 void
 379 initLinker( void )
 380 {
 381     RtsSymbolVal *sym;
 382
 383     symhash = allocStrHashTable();
 384
 385     /* populate the symbol table with stuff from the RTS */
 386     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
 387         insertStrHashTable(symhash, sym->lbl, sym->addr);
 388     }
 389 #   if defined(OBJFORMAT_ELF)
 390     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 391 #   endif
 392 }
 393
 394 /* -----------------------------------------------------------------------------
 395  * Add a DLL from which symbols may be found.  In the ELF case, just
 396  * do RTLD_GLOBAL-style add, so no further messing around needs to
 397  * happen in order that symbols in the loaded .so are findable --
 398  * lookupSymbol() will subsequently see them by dlsym on the program's
 399  * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 400  *
 401  * In the PEi386 case, open the DLLs and put handles to them in a
 402  * linked list.  When looking for a symbol, try all handles in the
 403  * list.
 404  */
 405
 406 #if defined(OBJFORMAT_PEi386)
 407 /* A record for storing handles into DLLs. */
 408
 409 typedef
 410    struct _OpenedDLL {
 411       char*              name;
 412       struct _OpenedDLL* next;
 413       HINSTANCE instance;
 414    }
 415    OpenedDLL;
 416
 417 /* A list thereof. */
 418 static OpenedDLL* opened_dlls = NULL;
 419 #endif
 420
 421
 422
 423 char*
 424 addDLL ( char* path, char* dll_name )
 425 {
 426 #  if defined(OBJFORMAT_ELF)
 427    void *hdl;
 428    char *buf;
 429    char *errmsg;
 430
 431    if (path == NULL || strlen(path) == 0) {
 432       buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
 433       sprintf(buf, "lib%s.so", dll_name);
 434    } else {
 435       buf = stgMallocBytes(strlen(path) + 1 + strlen(dll_name) + 10, "addDll");
 436       sprintf(buf, "%s/lib%s.so", path, dll_name);
 437    }
 438    hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL );
 439    free(buf);
 440    if (hdl == NULL) {
 441       /* dlopen failed; return a ptr to the error msg. */
 442       errmsg = dlerror();
 443       if (errmsg == NULL) errmsg = "addDLL: unknown error";
 444       return errmsg;
 445    } else {
 446       return NULL;
 447    }
 448    /*NOTREACHED*/
 449
 450 #  elif defined(OBJFORMAT_PEi386)
 451
 452    /* Add this DLL to the list of DLLs in which to search for symbols.
 453       The path argument is ignored. */
 454    char*      buf;
 455    OpenedDLL* o_dll;
 456    HINSTANCE  instance;
 457
 458    /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
 459
 460    /* See if we've already got it, and ignore if so. */
 461    for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
 462       if (0 == strcmp(o_dll->name, dll_name))
 463          return NULL;
 464    }
 465
 466    buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
 467    sprintf(buf, "%s.DLL", dll_name);
 468    instance = LoadLibrary(buf);
 469    free(buf);
 470    if (instance == NULL) {
 471      /* LoadLibrary failed; return a ptr to the error msg. */
 472      return "addDLL: unknown error";
 473    }
 474
 475    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
 476    o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
 477    strcpy(o_dll->name, dll_name);
 478    o_dll->instance = instance;
 479    o_dll->next     = opened_dlls;
 480    opened_dlls     = o_dll;
 481
 482    return NULL;
 483 #  else
 484    barf("addDLL: not implemented on this platform");
 485 #  endif
 486 }
 487
 488 /* -----------------------------------------------------------------------------
 489  * lookup a symbol in the hash table
 490  */
 491 void *
 492 lookupSymbol( char *lbl )
 493 {
 494     void *val;
 495     ASSERT(symhash != NULL);
 496     val = lookupStrHashTable(symhash, lbl);
 497
 498     if (val == NULL) {
 499 #       if defined(OBJFORMAT_ELF)
 500         return dlsym(dl_prog_handle, lbl);
 501 #       elif defined(OBJFORMAT_PEi386)
 502         OpenedDLL* o_dll;
 503         void* sym;
 504         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
 505            /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
 506            if (lbl[0] == '_') {
 507              /* HACK: if the name has an initial underscore, try stripping
 508                 it off & look that up first. I've yet to verify whether there's
 509                 a Rule that governs whether an initial '_' *should always* be
 510                 stripped off when mapping from import lib name to the DLL name.
 511              */
 512              sym = GetProcAddress(o_dll->instance, (lbl+1));
 513              if (sym != NULL) return sym;
 514            }
 515            sym = GetProcAddress(o_dll->instance, lbl);
 516            if (sym != NULL) return sym;
 517         }
 518         return NULL;
 519 #       else
 520         ASSERT(2+2 == 5);
 521         return NULL;
 522 #       endif
 523     } else {
 524         return val;
 525     }
 526 }
 527
 528 static
 529 void *
 530 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 531 {
 532     void *val;
 533     val = lookupStrHashTable(oc->lochash, lbl);
 534
 535     if (val == NULL) {
 536         return NULL;
 537     } else {
 538         return val;
 539     }
 540 }
 541
 542
 543 /* -----------------------------------------------------------------------------
 544  * Load an obj (populate the global symbol table, but don't resolve yet)
 545  *
 546  * Returns: 1 if ok, 0 on error.
 547  */
 548 HsInt
 549 loadObj( char *path )
 550 {
 551    ObjectCode* oc;
 552    struct stat st;
 553    int r, n;
 554    FILE *f;
 555
 556    /* fprintf(stderr, "loadObj %s\n", path ); */
 557 #  ifdef DEBUG
 558    /* assert that we haven't already loaded this object */
 559    {
 560        ObjectCode *o;
 561        for (o = objects; o; o = o->next)
 562            ASSERT(strcmp(o->fileName, path));
 563    }
 564 #  endif /* DEBUG */
 565
 566    oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
 567
 568 #  if defined(OBJFORMAT_ELF)
 569    oc->formatName = "ELF";
 570 #  elif defined(OBJFORMAT_PEi386)
 571    oc->formatName = "PEi386";
 572 #  else
 573    free(oc);
 574    barf("loadObj: not implemented on this platform");
 575 #  endif
 576
 577    r = stat(path, &st);
 578    if (r == -1) { return 0; }
 579
 580    /* sigh, strdup() isn't a POSIX function, so do it the long way */
 581    oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
 582    strcpy(oc->fileName, path);
 583
 584    oc->fileSize          = st.st_size;
 585    oc->image             = stgMallocBytes( st.st_size, "loadObj(image)" );
 586    oc->symbols           = NULL;
 587    oc->sections          = NULL;
 588    oc->lochash           = allocStrHashTable();
 589
 590    /* chain it onto the list of objects */
 591    oc->next              = objects;
 592    objects               = oc;
 593
 594    /* load the image into memory */
 595    f = fopen(path, "rb");
 596    if (!f) {
 597        barf("loadObj: can't read `%s'", path);
 598    }
 599    n = fread ( oc->image, 1, oc->fileSize, f );
 600    if (n != oc->fileSize) {
 601       fclose(f);
 602       barf("loadObj: error whilst reading `%s'", path);
 603    }
 604
 605    /* verify the in-memory image */
 606 #  if defined(OBJFORMAT_ELF)
 607    r = ocVerifyImage_ELF ( oc );
 608 #  elif defined(OBJFORMAT_PEi386)
 609    r = ocVerifyImage_PEi386 ( oc );
 610 #  else
 611    barf("loadObj: no verify method");
 612 #  endif
 613    if (!r) { return r; }
 614
 615    /* build the symbol list for this image */
 616 #  if defined(OBJFORMAT_ELF)
 617    r = ocGetNames_ELF ( oc );
 618 #  elif defined(OBJFORMAT_PEi386)
 619    r = ocGetNames_PEi386 ( oc );
 620 #  else
 621    barf("loadObj: no getNames method");
 622 #  endif
 623    if (!r) { return r; }
 624
 625    /* loaded, but not resolved yet */
 626    oc->status = OBJECT_LOADED;
 627
 628    return 1;
 629 }
 630
 631 /* -----------------------------------------------------------------------------
 632  * resolve all the currently unlinked objects in memory
 633  *
 634  * Returns: 1 if ok, 0 on error.
 635  */
 636 HsInt
 637 resolveObjs( void )
 638 {
 639     ObjectCode *oc;
 640     int r;
 641
 642     for (oc = objects; oc; oc = oc->next) {
 643         if (oc->status != OBJECT_RESOLVED) {
 644 #           if defined(OBJFORMAT_ELF)
 645             r = ocResolve_ELF ( oc );
 646 #           elif defined(OBJFORMAT_PEi386)
 647             r = ocResolve_PEi386 ( oc );
 648 #           else
 649             barf("resolveObjs: not implemented on this platform");
 650 #           endif
 651             if (!r) { return r; }
 652             oc->status = OBJECT_RESOLVED;
 653         }
 654     }
 655     return 1;
 656 }
 657
 658 /* -----------------------------------------------------------------------------
 659  * delete an object from the pool
 660  */
 661 HsInt
 662 unloadObj( char *path )
 663 {
 664     ObjectCode *oc, *prev;
 665
 666     ASSERT(symhash != NULL);
 667     ASSERT(objects != NULL);
 668
 669     prev = NULL;
 670     for (oc = objects; oc; prev = oc, oc = oc->next) {
 671         if (!strcmp(oc->fileName,path)) {
 672
 673             /* Remove all the mappings for the symbols within this
 674              * object..
 675              */
 676             {
 677                 int i;
 678                 for (i = 0; i < oc->n_symbols; i++) {
 679                    if (oc->symbols[i] != NULL) {
 680                        removeStrHashTable(symhash, oc->symbols[i], NULL);
 681                    }
 682                 }
 683             }
 684
 685             if (prev == NULL) {
 686                 objects = oc->next;
 687             } else {
 688                 prev->next = oc->next;
 689             }
 690
 691             /* We're going to leave this in place, in case there are
 692                any pointers from the heap into it: */
 693             /* free(oc->image); */
 694             free(oc->fileName);
 695             free(oc->symbols);
 696             free(oc->sections);
 697             /* The local hash table should have been freed at the end
 698                of the ocResolve_ call on it. */
 699             ASSERT(oc->lochash == NULL);
 700             free(oc);
 701             return 1;
 702         }
 703     }
 704
 705     belch("unloadObj: can't find `%s' to unload", path);
 706     return 0;
 707 }
 708
 709 /* --------------------------------------------------------------------------
 710  * PEi386 specifics (Win32 targets)
 711  * ------------------------------------------------------------------------*/
 712
 713 /* The information for this linker comes from
 714       Microsoft Portable Executable
 715       and Common Object File Format Specification
 716       revision 5.1 January 1998
 717    which SimonM says comes from the MS Developer Network CDs.
 718 */
 719
 720
 721 #if defined(OBJFORMAT_PEi386)
 722
 723
 724
 725 typedef unsigned char  UChar;
 726 typedef unsigned short UInt16;
 727 typedef unsigned int   UInt32;
 728 typedef          int   Int32;
 729
 730
 731 typedef
 732    struct {
 733       UInt16 Machine;
 734       UInt16 NumberOfSections;
 735       UInt32 TimeDateStamp;
 736       UInt32 PointerToSymbolTable;
 737       UInt32 NumberOfSymbols;
 738       UInt16 SizeOfOptionalHeader;
 739       UInt16 Characteristics;
 740    }
 741    COFF_header;
 742
 743 #define sizeof_COFF_header 20
 744
 745
 746 typedef
 747    struct {
 748       UChar  Name[8];
 749       UInt32 VirtualSize;
 750       UInt32 VirtualAddress;
 751       UInt32 SizeOfRawData;
 752       UInt32 PointerToRawData;
 753       UInt32 PointerToRelocations;
 754       UInt32 PointerToLinenumbers;
 755       UInt16 NumberOfRelocations;
 756       UInt16 NumberOfLineNumbers;
 757       UInt32 Characteristics;
 758    }
 759    COFF_section;
 760
 761 #define sizeof_COFF_section 40
 762
 763
 764 typedef
 765    struct {
 766       UChar  Name[8];
 767       UInt32 Value;
 768       UInt16 SectionNumber;
 769       UInt16 Type;
 770       UChar  StorageClass;
 771       UChar  NumberOfAuxSymbols;
 772    }
 773    COFF_symbol;
 774
 775 #define sizeof_COFF_symbol 18
 776
 777
 778 typedef
 779    struct {
 780       UInt32 VirtualAddress;
 781       UInt32 SymbolTableIndex;
 782       UInt16 Type;
 783    }
 784    COFF_reloc;
 785
 786 #define sizeof_COFF_reloc 10
 787
 788
 789 /* From PE spec doc, section 3.3.2 */
 790 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
 791    windows.h -- for the same purpose, but I want to know what I'm
 792    getting, here. */
 793 #define MYIMAGE_FILE_RELOCS_STRIPPED     0x0001
 794 #define MYIMAGE_FILE_EXECUTABLE_IMAGE    0x0002
 795 #define MYIMAGE_FILE_DLL                 0x2000
 796 #define MYIMAGE_FILE_SYSTEM              0x1000
 797 #define MYIMAGE_FILE_BYTES_REVERSED_HI   0x8000
 798 #define MYIMAGE_FILE_BYTES_REVERSED_LO   0x0080
 799 #define MYIMAGE_FILE_32BIT_MACHINE       0x0100
 800
 801 /* From PE spec doc, section 5.4.2 and 5.4.4 */
 802 #define MYIMAGE_SYM_CLASS_EXTERNAL       2
 803 #define MYIMAGE_SYM_CLASS_STATIC         3
 804 #define MYIMAGE_SYM_UNDEFINED            0
 805
 806 /* From PE spec doc, section 4.1 */
 807 #define MYIMAGE_SCN_CNT_CODE             0x00000020
 808 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
 809
 810 /* From PE spec doc, section 5.2.1 */
 811 #define MYIMAGE_REL_I386_DIR32           0x0006
 812 #define MYIMAGE_REL_I386_REL32           0x0014
 813
 814
 815 /* We use myindex to calculate array addresses, rather than
 816    simply doing the normal subscript thing.  That's because
 817    some of the above structs have sizes which are not
 818    a whole number of words.  GCC rounds their sizes up to a
 819    whole number of words, which means that the address calcs
 820    arising from using normal C indexing or pointer arithmetic
 821    are just plain wrong.  Sigh.
 822 */
 823 static UChar *
 824 myindex ( int scale, void* base, int index )
 825 {
 826    return
 827       ((UChar*)base) + scale * index;
 828 }
 829
 830
 831 static void
 832 printName ( UChar* name, UChar* strtab )
 833 {
 834    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 835       UInt32 strtab_offset = * (UInt32*)(name+4);
 836       fprintf ( stderr, "%s", strtab + strtab_offset );
 837    } else {
 838       int i;
 839       for (i = 0; i < 8; i++) {
 840          if (name[i] == 0) break;
 841          fprintf ( stderr, "%c", name[i] );
 842       }
 843    }
 844 }
 845
 846
 847 static void
 848 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
 849 {
 850    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 851       UInt32 strtab_offset = * (UInt32*)(name+4);
 852       strncpy ( dst, strtab+strtab_offset, dstSize );
 853       dst[dstSize-1] = 0;
 854    } else {
 855       int i = 0;
 856       while (1) {
 857          if (i >= 8) break;
 858          if (name[i] == 0) break;
 859          dst[i] = name[i];
 860          i++;
 861       }
 862       dst[i] = 0;
 863    }
 864 }
 865
 866
 867 static UChar *
 868 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
 869 {
 870    UChar* newstr;
 871    /* If the string is longer than 8 bytes, look in the
 872       string table for it -- this will be correctly zero terminated.
 873    */
 874    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 875       UInt32 strtab_offset = * (UInt32*)(name+4);
 876       return ((UChar*)strtab) + strtab_offset;
 877    }
 878    /* Otherwise, if shorter than 8 bytes, return the original,
 879       which by defn is correctly terminated.
 880    */
 881    if (name[7]==0) return name;
 882    /* The annoying case: 8 bytes.  Copy into a temporary
 883       (which is never freed ...)
 884    */
 885    newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
 886    ASSERT(newstr);
 887    strncpy(newstr,name,8);
 888    newstr[8] = 0;
 889    return newstr;
 890 }
 891
 892
 893 /* Just compares the short names (first 8 chars) */
 894 static COFF_section *
 895 findPEi386SectionCalled ( ObjectCode* oc,  char* name )
 896 {
 897    int i;
 898    COFF_header* hdr
 899       = (COFF_header*)(oc->image);
 900    COFF_section* sectab
 901       = (COFF_section*) (
 902            ((UChar*)(oc->image))
 903            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 904         );
 905    for (i = 0; i < hdr->NumberOfSections; i++) {
 906       UChar* n1;
 907       UChar* n2;
 908       COFF_section* section_i
 909          = (COFF_section*)
 910            myindex ( sizeof_COFF_section, sectab, i );
 911       n1 = (UChar*) &(section_i->Name);
 912       n2 = name;
 913       if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
 914           n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
 915           n1[6]==n2[6] && n1[7]==n2[7])
 916          return section_i;
 917    }
 918
 919    return NULL;
 920 }
 921
 922
 923 static void
 924 zapTrailingAtSign ( UChar* sym )
 925 {
 926 #  define my_isdigit(c) ((c) >= '0' && (c) <= '9')
 927    int i, j;
 928    if (sym[0] == 0) return;
 929    i = 0;
 930    while (sym[i] != 0) i++;
 931    i--;
 932    j = i;
 933    while (j > 0 && my_isdigit(sym[j])) j--;
 934    if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
 935 #  undef my_isdigit
 936 }
 937
 938
 939 static int
 940 ocVerifyImage_PEi386 ( ObjectCode* oc )
 941 {
 942    int i, j;
 943    COFF_header*  hdr;
 944    COFF_section* sectab;
 945    COFF_symbol*  symtab;
 946    UChar*        strtab;
 947    /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
 948    hdr = (COFF_header*)(oc->image);
 949    sectab = (COFF_section*) (
 950                ((UChar*)(oc->image))
 951                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 952             );
 953    symtab = (COFF_symbol*) (
 954                ((UChar*)(oc->image))
 955                + hdr->PointerToSymbolTable
 956             );
 957    strtab = ((UChar*)symtab)
 958             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 959
 960    if (hdr->Machine != 0x14c) {
 961       belch("Not x86 PEi386");
 962       return 0;
 963    }
 964    if (hdr->SizeOfOptionalHeader != 0) {
 965       belch("PEi386 with nonempty optional header");
 966       return 0;
 967    }
 968    if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
 969         (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
 970         (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
 971         (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
 972       belch("Not a PEi386 object file");
 973       return 0;
 974    }
 975    if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
 976         /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
 977       belch("Invalid PEi386 word size or endiannness: %d",
 978             (int)(hdr->Characteristics));
 979       return 0;
 980    }
 981    /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
 982    if (* (UInt32*)strtab > 510000) {
 983       belch("PEi386 object has suspiciously large string table; > 64k relocs?");
 984       return 0;
 985    }
 986
 987    /* No further verification after this point; only debug printing. */
 988    i = 0;
 989    IF_DEBUG(linker, i=1);
 990    if (i == 0) return 1;
 991
 992    fprintf ( stderr,
 993              "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
 994    fprintf ( stderr,
 995              "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
 996    fprintf ( stderr,
 997              "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
 998
 999    fprintf ( stderr, "\n" );
1000    fprintf ( stderr,
1001              "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
1002    fprintf ( stderr,
1003              "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
1004    fprintf ( stderr,
1005              "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1006    fprintf ( stderr,
1007              "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
1008    fprintf ( stderr,
1009              "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
1010    fprintf ( stderr,
1011              "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
1012    fprintf ( stderr,
1013              "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
1014
1015    /* Print the section table. */
1016    fprintf ( stderr, "\n" );
1017    for (i = 0; i < hdr->NumberOfSections; i++) {
1018       COFF_reloc* reltab;
1019       COFF_section* sectab_i
1020          = (COFF_section*)
1021            myindex ( sizeof_COFF_section, sectab, i );
1022       fprintf ( stderr,
1023                 "\n"
1024                 "section %d\n"
1025                 "     name `",
1026                 i
1027               );
1028       printName ( sectab_i->Name, strtab );
1029       fprintf ( stderr,
1030                 "'\n"
1031                 "    vsize %d\n"
1032                 "    vaddr %d\n"
1033                 "  data sz %d\n"
1034                 " data off %d\n"
1035                 "  num rel %d\n"
1036                 "  off rel %d\n",
1037                 sectab_i->VirtualSize,
1038                 sectab_i->VirtualAddress,
1039                 sectab_i->SizeOfRawData,
1040                 sectab_i->PointerToRawData,
1041                 sectab_i->NumberOfRelocations,
1042                 sectab_i->PointerToRelocations
1043               );
1044       reltab = (COFF_reloc*) (
1045                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1046                );
1047
1048       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1049          COFF_symbol* sym;
1050          COFF_reloc* rel = (COFF_reloc*)
1051                            myindex ( sizeof_COFF_reloc, reltab, j );
1052          fprintf ( stderr,
1053                    "        type 0x%-4x   vaddr 0x%-8x   name `",
1054                    (UInt32)rel->Type,
1055                    rel->VirtualAddress );
1056          sym = (COFF_symbol*)
1057                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1058          printName ( sym->Name, strtab -10 );
1059          fprintf ( stderr, "'\n" );
1060       }
1061       fprintf ( stderr, "\n" );
1062    }
1063
1064    fprintf ( stderr, "\n" );
1065    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1066    fprintf ( stderr, "---START of string table---\n");
1067    for (i = 4; i < *(Int32*)strtab; i++) {
1068       if (strtab[i] == 0)
1069          fprintf ( stderr, "\n"); else
1070          fprintf( stderr, "%c", strtab[i] );
1071    }
1072    fprintf ( stderr, "--- END  of string table---\n");
1073
1074    fprintf ( stderr, "\n" );
1075    i = 0;
1076    while (1) {
1077       COFF_symbol* symtab_i;
1078       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1079       symtab_i = (COFF_symbol*)
1080                  myindex ( sizeof_COFF_symbol, symtab, i );
1081       fprintf ( stderr,
1082                 "symbol %d\n"
1083                 "     name `",
1084                 i
1085               );
1086       printName ( symtab_i->Name, strtab );
1087       fprintf ( stderr,
1088                 "'\n"
1089                 "    value 0x%x\n"
1090                 "     sec# %d\n"
1091                 "     type 0x%x\n"
1092                 "   sclass 0x%x\n"
1093                 "     nAux %d\n",
1094                 symtab_i->Value,
1095                 (Int32)(symtab_i->SectionNumber) - 1,
1096                 (UInt32)symtab_i->Type,
1097                 (UInt32)symtab_i->StorageClass,
1098                 (UInt32)symtab_i->NumberOfAuxSymbols
1099               );
1100       i += symtab_i->NumberOfAuxSymbols;
1101       i++;
1102    }
1103
1104    fprintf ( stderr, "\n" );
1105    return 1;
1106 }
1107
1108
1109 static int
1110 ocGetNames_PEi386 ( ObjectCode* oc )
1111 {
1112    COFF_header*  hdr;
1113    COFF_section* sectab;
1114    COFF_symbol*  symtab;
1115    UChar*        strtab;
1116
1117    UChar* sname;
1118    void*  addr;
1119    int    i;
1120
1121    hdr = (COFF_header*)(oc->image);
1122    sectab = (COFF_section*) (
1123                ((UChar*)(oc->image))
1124                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1125             );
1126    symtab = (COFF_symbol*) (
1127                ((UChar*)(oc->image))
1128                + hdr->PointerToSymbolTable
1129             );
1130    strtab = ((UChar*)(oc->image))
1131             + hdr->PointerToSymbolTable
1132             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1133
1134    /* Copy exported symbols into the ObjectCode. */
1135
1136    oc->n_symbols = hdr->NumberOfSymbols;
1137    oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
1138                                   "ocGetNames_PEi386(oc->symbols)");
1139    /* Call me paranoid; I don't care. */
1140    for (i = 0; i < oc->n_symbols; i++)
1141       oc->symbols[i] = NULL;
1142
1143    i = 0;
1144    while (1) {
1145       COFF_symbol* symtab_i;
1146       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1147       symtab_i = (COFF_symbol*)
1148                  myindex ( sizeof_COFF_symbol, symtab, i );
1149
1150       if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL &&
1151           symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1152
1153          /* This symbol is global and defined, viz, exported */
1154          COFF_section* sectabent;
1155
1156          /* cstring_from_COFF_symbol_name always succeeds. */
1157          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1158
1159          /* for MYIMAGE_SYMCLASS_EXTERNAL
1160                 && !MYIMAGE_SYM_UNDEFINED,
1161             the address of the symbol is:
1162                 address of relevant section + offset in section
1163          */
1164          sectabent = (COFF_section*)
1165                      myindex ( sizeof_COFF_section,
1166                                sectab,
1167                                symtab_i->SectionNumber-1 );
1168          addr = ((UChar*)(oc->image))
1169                 + (sectabent->PointerToRawData
1170                    + symtab_i->Value);
1171          /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */
1172          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1173          ASSERT(i >= 0 && i < oc->n_symbols);
1174          oc->symbols[i] = sname;
1175          insertStrHashTable(symhash, sname, addr);
1176       }
1177       i += symtab_i->NumberOfAuxSymbols;
1178       i++;
1179    }
1180
1181    /* Copy section information into the ObjectCode. */
1182
1183    oc->n_sections = hdr->NumberOfSections;
1184    oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section),
1185                                   "ocGetNamesPEi386" );
1186
1187    for (i = 0; i < oc->n_sections; i++) {
1188       UChar* start;
1189       UChar* end;
1190
1191       SectionKind kind
1192          = SECTIONKIND_OTHER;
1193       COFF_section* sectab_i
1194          = (COFF_section*)
1195            myindex ( sizeof_COFF_section, sectab, i );
1196       IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1197
1198 #if 0
1199       /* I'm sure this is the Right Way to do it.  However, the
1200          alternative of testing the sectab_i->Name field seems to
1201          work ok with Cygwin.
1202       */
1203       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1204           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1205          kind = SECTIONKIND_CODE_OR_RODATA;
1206 #endif
1207
1208       if (0==strcmp(".text",sectab_i->Name) ||
1209           0==strcmp(".rodata",sectab_i->Name))
1210          kind = SECTIONKIND_CODE_OR_RODATA;
1211       if (0==strcmp(".data",sectab_i->Name) ||
1212           0==strcmp(".bss",sectab_i->Name))
1213          kind = SECTIONKIND_RWDATA;
1214
1215       start = ((UChar*)(oc->image))
1216               + sectab_i->PointerToRawData;
1217       end   = start
1218               + sectab_i->SizeOfRawData - 1;
1219
1220       if (kind == SECTIONKIND_OTHER) {
1221          belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1222          return 0;
1223       }
1224
1225       oc->sections[i].start = start;
1226       oc->sections[i].end   = end;
1227       oc->sections[i].kind  = kind;
1228    }
1229
1230    return 1;
1231 }
1232
1233
1234 static int
1235 ocResolve_PEi386 ( ObjectCode* oc )
1236 {
1237    COFF_header*  hdr;
1238    COFF_section* sectab;
1239    COFF_symbol*  symtab;
1240    UChar*        strtab;
1241
1242    UInt32        A;
1243    UInt32        S;
1244    UInt32*       pP;
1245
1246    int i, j;
1247
1248    /* ToDo: should be variable-sized?  But is at least safe in the
1249       sense of buffer-overrun-proof. */
1250    char symbol[1000];
1251    /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1252
1253    hdr = (COFF_header*)(oc->image);
1254    sectab = (COFF_section*) (
1255                ((UChar*)(oc->image))
1256                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1257             );
1258    symtab = (COFF_symbol*) (
1259                ((UChar*)(oc->image))
1260                + hdr->PointerToSymbolTable
1261             );
1262    strtab = ((UChar*)(oc->image))
1263             + hdr->PointerToSymbolTable
1264             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1265
1266    for (i = 0; i < hdr->NumberOfSections; i++) {
1267       COFF_section* sectab_i
1268          = (COFF_section*)
1269            myindex ( sizeof_COFF_section, sectab, i );
1270       COFF_reloc* reltab
1271          = (COFF_reloc*) (
1272               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1273            );
1274       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1275          COFF_symbol* sym;
1276          COFF_reloc* reltab_j
1277             = (COFF_reloc*)
1278               myindex ( sizeof_COFF_reloc, reltab, j );
1279
1280          /* the location to patch */
1281          pP = (UInt32*)(
1282                  ((UChar*)(oc->image))
1283                  + (sectab_i->PointerToRawData
1284                     + reltab_j->VirtualAddress
1285                     - sectab_i->VirtualAddress )
1286               );
1287          /* the existing contents of pP */
1288          A = *pP;
1289          /* the symbol to connect to */
1290          sym = (COFF_symbol*)
1291                myindex ( sizeof_COFF_symbol,
1292                          symtab, reltab_j->SymbolTableIndex );
1293          IF_DEBUG(linker,
1294                   fprintf ( stderr,
1295                             "reloc sec %2d num %3d:  type 0x%-4x   "
1296                             "vaddr 0x%-8x   name `",
1297                             i, j,
1298                             (UInt32)reltab_j->Type,
1299                             reltab_j->VirtualAddress );
1300                             printName ( sym->Name, strtab );
1301                             fprintf ( stderr, "'\n" ));
1302
1303          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1304             COFF_section* section_sym
1305                = findPEi386SectionCalled ( oc, sym->Name );
1306             if (!section_sym) {
1307                fprintf ( stderr, "bad section = `%s'\n", sym->Name );
1308                barf("Can't find abovementioned PEi386 section");
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("ocResolve_PEi386: %s: unknown symbol `%s'",
1322                       oc->fileName, symbol);
1323                 return 0;
1324             }
1325          }
1326
1327          switch (reltab_j->Type) {
1328             case MYIMAGE_REL_I386_DIR32:
1329                *pP = A + S;
1330                break;
1331             case MYIMAGE_REL_I386_REL32:
1332                /* Tricky.  We have to insert a displacement at
1333                   pP which, when added to the PC for the _next_
1334                   insn, gives the address of the target (S).
1335                   Problem is to know the address of the next insn
1336                   when we only know pP.  We assume that this
1337                   literal field is always the last in the insn,
1338                   so that the address of the next insn is pP+4
1339                   -- hence the constant 4.
1340                   Also I don't know if A should be added, but so
1341                   far it has always been zero.
1342                */
1343                ASSERT(A==0);
1344                *pP = S - ((UInt32)pP) - 4;
1345                break;
1346             default:
1347                fprintf(stderr,
1348                        "unhandled PEi386 relocation type %d\n",
1349                        reltab_j->Type);
1350                barf("unhandled PEi386 relocation type");
1351                return 0;
1352          }
1353
1354       }
1355    }
1356
1357    /* fprintf(stderr, "completed     %s\n", oc->fileName); */
1358    return 1;
1359 }
1360
1361 #endif /* defined(OBJFORMAT_PEi386) */
1362
1363
1364 /* --------------------------------------------------------------------------
1365  * ELF specifics
1366  * ------------------------------------------------------------------------*/
1367
1368 #if defined(OBJFORMAT_ELF)
1369
1370 #define FALSE 0
1371 #define TRUE  1
1372
1373 #if defined(sparc_TARGET_ARCH)
1374 #  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
1375 #elif defined(i386_TARGET_ARCH)
1376 #  define ELF_TARGET_386    /* Used inside <elf.h> */
1377 #endif
1378 /* There is a similar case for IA64 in the Solaris2 headers if this
1379  * ever becomes relevant.
1380  */
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 */