ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.59 2001/08/21 15:22: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(getProgArgv)                         \
 278       SymX(setProgArgv)                         \
 279       SymX(resetNonBlockingFd)                  \
 280       SymX(performGC)                           \
 281       SymX(getStablePtr)                        \
 282       SymX(stable_ptr_table)                    \
 283       SymX(shutdownHaskellAndExit)              \
 284       Sym(stg_enterStackTop)                    \
 285       Sym(stg_yield_to_interpreter)             \
 286       Sym(StgReturn)                            \
 287       Sym(init_stack)                           \
 288       SymX(cmp_thread)                          \
 289       Sym(__init_PrelGHC)                       \
 290       SymX(freeHaskellFunctionPtr)              \
 291       SymX(OnExitHook)                          \
 292       SymX(ErrorHdrHook)                        \
 293       SymX(NoRunnableThreadsHook)               \
 294       SymX(StackOverflowHook)                   \
 295       SymX(OutOfHeapHook)                       \
 296       SymX(MallocFailHook)                      \
 297       SymX(PatErrorHdrHook)                     \
 298       SymX(defaultsHook)                        \
 299       SymX(PreTraceHook)                        \
 300       SymX(PostTraceHook)                       \
 301       SymX(createAdjustor)                      \
 302       SymX(rts_mkChar)                          \
 303       SymX(rts_mkInt)                           \
 304       SymX(rts_mkInt8)                          \
 305       SymX(rts_mkInt16)                         \
 306       SymX(rts_mkInt32)                         \
 307       SymX(rts_mkInt64)                         \
 308       SymX(rts_mkWord)                          \
 309       SymX(rts_mkWord8)                         \
 310       SymX(rts_mkWord16)                        \
 311       SymX(rts_mkWord32)                        \
 312       SymX(rts_mkWord64)                        \
 313       SymX(rts_mkPtr)                           \
 314       SymX(rts_mkFloat)                         \
 315       SymX(rts_mkDouble)                        \
 316       SymX(rts_mkStablePtr)                     \
 317       SymX(rts_mkBool)                          \
 318       SymX(rts_mkString)                        \
 319       SymX(rts_apply)                           \
 320       SymX(rts_mkAddr)                          \
 321       SymX(rts_getChar)                         \
 322       SymX(rts_getInt)                          \
 323       SymX(rts_getInt32)                        \
 324       SymX(rts_getWord)                         \
 325       SymX(rts_getWord32)                       \
 326       SymX(rts_getPtr)                          \
 327       SymX(rts_getFloat)                        \
 328       SymX(rts_getDouble)                       \
 329       SymX(rts_getStablePtr)                    \
 330       SymX(rts_getBool)                         \
 331       SymX(rts_getAddr)                         \
 332       SymX(rts_eval)                            \
 333       SymX(rts_eval_)                           \
 334       SymX(rts_evalIO)                          \
 335       SymX(rts_evalLazyIO)                      \
 336       SymX(rts_checkSchedStatus)
 337
 338 #ifndef SUPPORT_LONG_LONGS
 339 #define RTS_LONG_LONG_SYMS /* nothing */
 340 #else
 341 #define RTS_LONG_LONG_SYMS                      \
 342       SymX(int64ToIntegerzh_fast)               \
 343       SymX(word64ToIntegerzh_fast)
 344 #endif /* SUPPORT_LONG_LONGS */
 345
 346 /* entirely bogus claims about types of these symbols */
 347 #define Sym(vvv)  extern void (vvv);
 348 #define SymX(vvv) /**/
 349 RTS_SYMBOLS
 350 RTS_LONG_LONG_SYMS
 351 RTS_POSIX_ONLY_SYMBOLS
 352 RTS_MINGW_ONLY_SYMBOLS
 353 #undef Sym
 354 #undef SymX
 355
 356 #ifdef LEADING_UNDERSCORE
 357 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
 358 #else
 359 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
 360 #endif
 361
 362 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
 363                     (void*)(&(vvv)) },
 364 #define SymX(vvv) Sym(vvv)
 365
 366 static RtsSymbolVal rtsSyms[] = {
 367       RTS_SYMBOLS
 368       RTS_LONG_LONG_SYMS
 369       RTS_POSIX_ONLY_SYMBOLS
 370       RTS_MINGW_ONLY_SYMBOLS
 371       { 0, 0 } /* sentinel */
 372 };
 373
 374 /* -----------------------------------------------------------------------------
 375  * initialize the object linker
 376  */
 377 #if defined(OBJFORMAT_ELF)
 378 static void *dl_prog_handle;
 379 #endif
 380
 381 void
 382 initLinker( void )
 383 {
 384     RtsSymbolVal *sym;
 385
 386     symhash = allocStrHashTable();
 387
 388     /* populate the symbol table with stuff from the RTS */
 389     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
 390         insertStrHashTable(symhash, sym->lbl, sym->addr);
 391     }
 392 #   if defined(OBJFORMAT_ELF)
 393     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
 394 #   endif
 395 }
 396
 397 /* -----------------------------------------------------------------------------
 398  * Add a DLL from which symbols may be found.  In the ELF case, just
 399  * do RTLD_GLOBAL-style add, so no further messing around needs to
 400  * happen in order that symbols in the loaded .so are findable --
 401  * lookupSymbol() will subsequently see them by dlsym on the program's
 402  * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 403  *
 404  * In the PEi386 case, open the DLLs and put handles to them in a
 405  * linked list.  When looking for a symbol, try all handles in the
 406  * list.
 407  */
 408
 409 #if defined(OBJFORMAT_PEi386)
 410 /* A record for storing handles into DLLs. */
 411
 412 typedef
 413    struct _OpenedDLL {
 414       char*              name;
 415       struct _OpenedDLL* next;
 416       HINSTANCE instance;
 417    }
 418    OpenedDLL;
 419
 420 /* A list thereof. */
 421 static OpenedDLL* opened_dlls = NULL;
 422 #endif
 423
 424
 425
 426 char*
 427 addDLL ( char* path, char* dll_name )
 428 {
 429 #  if defined(OBJFORMAT_ELF)
 430    void *hdl;
 431    char *buf;
 432    char *errmsg;
 433
 434    if (path == NULL || strlen(path) == 0) {
 435       buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
 436       sprintf(buf, "lib%s.so", dll_name);
 437    } else {
 438       buf = stgMallocBytes(strlen(path) + 1 + strlen(dll_name) + 10, "addDll");
 439       sprintf(buf, "%s/lib%s.so", path, dll_name);
 440    }
 441    hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL );
 442    free(buf);
 443    if (hdl == NULL) {
 444       /* dlopen failed; return a ptr to the error msg. */
 445       errmsg = dlerror();
 446       if (errmsg == NULL) errmsg = "addDLL: unknown error";
 447       return errmsg;
 448    } else {
 449       return NULL;
 450    }
 451    /*NOTREACHED*/
 452
 453 #  elif defined(OBJFORMAT_PEi386)
 454
 455    /* Add this DLL to the list of DLLs in which to search for symbols.
 456       The path argument is ignored. */
 457    char*      buf;
 458    OpenedDLL* o_dll;
 459    HINSTANCE  instance;
 460
 461    /* fprintf(stderr, "\naddDLL; path=`%s', dll_name = `%s'\n", path, dll_name); */
 462
 463    /* See if we've already got it, and ignore if so. */
 464    for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
 465       if (0 == strcmp(o_dll->name, dll_name))
 466          return NULL;
 467    }
 468
 469    buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
 470    sprintf(buf, "%s.DLL", dll_name);
 471    instance = LoadLibrary(buf);
 472    free(buf);
 473    if (instance == NULL) {
 474      /* LoadLibrary failed; return a ptr to the error msg. */
 475      return "addDLL: unknown error";
 476    }
 477
 478    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
 479    o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
 480    strcpy(o_dll->name, dll_name);
 481    o_dll->instance = instance;
 482    o_dll->next     = opened_dlls;
 483    opened_dlls     = o_dll;
 484
 485    return NULL;
 486 #  else
 487    barf("addDLL: not implemented on this platform");
 488 #  endif
 489 }
 490
 491 /* -----------------------------------------------------------------------------
 492  * lookup a symbol in the hash table
 493  */
 494 void *
 495 lookupSymbol( char *lbl )
 496 {
 497     void *val;
 498     ASSERT(symhash != NULL);
 499     val = lookupStrHashTable(symhash, lbl);
 500
 501     if (val == NULL) {
 502 #       if defined(OBJFORMAT_ELF)
 503         return dlsym(dl_prog_handle, lbl);
 504 #       elif defined(OBJFORMAT_PEi386)
 505         OpenedDLL* o_dll;
 506         void* sym;
 507         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
 508            /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
 509            if (lbl[0] == '_') {
 510              /* HACK: if the name has an initial underscore, try stripping
 511                 it off & look that up first. I've yet to verify whether there's
 512                 a Rule that governs whether an initial '_' *should always* be
 513                 stripped off when mapping from import lib name to the DLL name.
 514              */
 515              sym = GetProcAddress(o_dll->instance, (lbl+1));
 516              if (sym != NULL) return sym;
 517            }
 518            sym = GetProcAddress(o_dll->instance, lbl);
 519            if (sym != NULL) return sym;
 520         }
 521         return NULL;
 522 #       else
 523         ASSERT(2+2 == 5);
 524         return NULL;
 525 #       endif
 526     } else {
 527         return val;
 528     }
 529 }
 530
 531 static
 532 void *
 533 lookupLocalSymbol( ObjectCode* oc, char *lbl )
 534 {
 535     void *val;
 536     val = lookupStrHashTable(oc->lochash, lbl);
 537
 538     if (val == NULL) {
 539         return NULL;
 540     } else {
 541         return val;
 542     }
 543 }
 544
 545
 546 /* -----------------------------------------------------------------------------
 547  * Load an obj (populate the global symbol table, but don't resolve yet)
 548  *
 549  * Returns: 1 if ok, 0 on error.
 550  */
 551 HsInt
 552 loadObj( char *path )
 553 {
 554    ObjectCode* oc;
 555    struct stat st;
 556    int r, n;
 557    FILE *f;
 558
 559    /* fprintf(stderr, "loadObj %s\n", path ); */
 560 #  ifdef DEBUG
 561    /* assert that we haven't already loaded this object */
 562    {
 563        ObjectCode *o;
 564        for (o = objects; o; o = o->next)
 565            ASSERT(strcmp(o->fileName, path));
 566    }
 567 #  endif /* DEBUG */
 568
 569    oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
 570
 571 #  if defined(OBJFORMAT_ELF)
 572    oc->formatName = "ELF";
 573 #  elif defined(OBJFORMAT_PEi386)
 574    oc->formatName = "PEi386";
 575 #  else
 576    free(oc);
 577    barf("loadObj: not implemented on this platform");
 578 #  endif
 579
 580    r = stat(path, &st);
 581    if (r == -1) { return 0; }
 582
 583    /* sigh, strdup() isn't a POSIX function, so do it the long way */
 584    oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
 585    strcpy(oc->fileName, path);
 586
 587    oc->fileSize          = st.st_size;
 588    oc->image             = stgMallocBytes( st.st_size, "loadObj(image)" );
 589    oc->symbols           = NULL;
 590    oc->sections          = NULL;
 591    oc->lochash           = allocStrHashTable();
 592
 593    /* chain it onto the list of objects */
 594    oc->next              = objects;
 595    objects               = oc;
 596
 597    /* load the image into memory */
 598    f = fopen(path, "rb");
 599    if (!f) {
 600        barf("loadObj: can't read `%s'", path);
 601    }
 602    n = fread ( oc->image, 1, oc->fileSize, f );
 603    if (n != oc->fileSize) {
 604       fclose(f);
 605       barf("loadObj: error whilst reading `%s'", path);
 606    }
 607
 608    /* verify the in-memory image */
 609 #  if defined(OBJFORMAT_ELF)
 610    r = ocVerifyImage_ELF ( oc );
 611 #  elif defined(OBJFORMAT_PEi386)
 612    r = ocVerifyImage_PEi386 ( oc );
 613 #  else
 614    barf("loadObj: no verify method");
 615 #  endif
 616    if (!r) { return r; }
 617
 618    /* build the symbol list for this image */
 619 #  if defined(OBJFORMAT_ELF)
 620    r = ocGetNames_ELF ( oc );
 621 #  elif defined(OBJFORMAT_PEi386)
 622    r = ocGetNames_PEi386 ( oc );
 623 #  else
 624    barf("loadObj: no getNames method");
 625 #  endif
 626    if (!r) { return r; }
 627
 628    /* loaded, but not resolved yet */
 629    oc->status = OBJECT_LOADED;
 630
 631    return 1;
 632 }
 633
 634 /* -----------------------------------------------------------------------------
 635  * resolve all the currently unlinked objects in memory
 636  *
 637  * Returns: 1 if ok, 0 on error.
 638  */
 639 HsInt
 640 resolveObjs( void )
 641 {
 642     ObjectCode *oc;
 643     int r;
 644
 645     for (oc = objects; oc; oc = oc->next) {
 646         if (oc->status != OBJECT_RESOLVED) {
 647 #           if defined(OBJFORMAT_ELF)
 648             r = ocResolve_ELF ( oc );
 649 #           elif defined(OBJFORMAT_PEi386)
 650             r = ocResolve_PEi386 ( oc );
 651 #           else
 652             barf("resolveObjs: not implemented on this platform");
 653 #           endif
 654             if (!r) { return r; }
 655             oc->status = OBJECT_RESOLVED;
 656         }
 657     }
 658     return 1;
 659 }
 660
 661 /* -----------------------------------------------------------------------------
 662  * delete an object from the pool
 663  */
 664 HsInt
 665 unloadObj( char *path )
 666 {
 667     ObjectCode *oc, *prev;
 668
 669     ASSERT(symhash != NULL);
 670     ASSERT(objects != NULL);
 671
 672     prev = NULL;
 673     for (oc = objects; oc; prev = oc, oc = oc->next) {
 674         if (!strcmp(oc->fileName,path)) {
 675
 676             /* Remove all the mappings for the symbols within this
 677              * object..
 678              */
 679             {
 680                 int i;
 681                 for (i = 0; i < oc->n_symbols; i++) {
 682                    if (oc->symbols[i] != NULL) {
 683                        removeStrHashTable(symhash, oc->symbols[i], NULL);
 684                    }
 685                 }
 686             }
 687
 688             if (prev == NULL) {
 689                 objects = oc->next;
 690             } else {
 691                 prev->next = oc->next;
 692             }
 693
 694             /* We're going to leave this in place, in case there are
 695                any pointers from the heap into it: */
 696             /* free(oc->image); */
 697             free(oc->fileName);
 698             free(oc->symbols);
 699             free(oc->sections);
 700             /* The local hash table should have been freed at the end
 701                of the ocResolve_ call on it. */
 702             ASSERT(oc->lochash == NULL);
 703             free(oc);
 704             return 1;
 705         }
 706     }
 707
 708     belch("unloadObj: can't find `%s' to unload", path);
 709     return 0;
 710 }
 711
 712 /* --------------------------------------------------------------------------
 713  * PEi386 specifics (Win32 targets)
 714  * ------------------------------------------------------------------------*/
 715
 716 /* The information for this linker comes from
 717       Microsoft Portable Executable
 718       and Common Object File Format Specification
 719       revision 5.1 January 1998
 720    which SimonM says comes from the MS Developer Network CDs.
 721 */
 722
 723
 724 #if defined(OBJFORMAT_PEi386)
 725
 726
 727
 728 typedef unsigned char  UChar;
 729 typedef unsigned short UInt16;
 730 typedef unsigned int   UInt32;
 731 typedef          int   Int32;
 732
 733
 734 typedef
 735    struct {
 736       UInt16 Machine;
 737       UInt16 NumberOfSections;
 738       UInt32 TimeDateStamp;
 739       UInt32 PointerToSymbolTable;
 740       UInt32 NumberOfSymbols;
 741       UInt16 SizeOfOptionalHeader;
 742       UInt16 Characteristics;
 743    }
 744    COFF_header;
 745
 746 #define sizeof_COFF_header 20
 747
 748
 749 typedef
 750    struct {
 751       UChar  Name[8];
 752       UInt32 VirtualSize;
 753       UInt32 VirtualAddress;
 754       UInt32 SizeOfRawData;
 755       UInt32 PointerToRawData;
 756       UInt32 PointerToRelocations;
 757       UInt32 PointerToLinenumbers;
 758       UInt16 NumberOfRelocations;
 759       UInt16 NumberOfLineNumbers;
 760       UInt32 Characteristics;
 761    }
 762    COFF_section;
 763
 764 #define sizeof_COFF_section 40
 765
 766
 767 typedef
 768    struct {
 769       UChar  Name[8];
 770       UInt32 Value;
 771       UInt16 SectionNumber;
 772       UInt16 Type;
 773       UChar  StorageClass;
 774       UChar  NumberOfAuxSymbols;
 775    }
 776    COFF_symbol;
 777
 778 #define sizeof_COFF_symbol 18
 779
 780
 781 typedef
 782    struct {
 783       UInt32 VirtualAddress;
 784       UInt32 SymbolTableIndex;
 785       UInt16 Type;
 786    }
 787    COFF_reloc;
 788
 789 #define sizeof_COFF_reloc 10
 790
 791
 792 /* From PE spec doc, section 3.3.2 */
 793 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
 794    windows.h -- for the same purpose, but I want to know what I'm
 795    getting, here. */
 796 #define MYIMAGE_FILE_RELOCS_STRIPPED     0x0001
 797 #define MYIMAGE_FILE_EXECUTABLE_IMAGE    0x0002
 798 #define MYIMAGE_FILE_DLL                 0x2000
 799 #define MYIMAGE_FILE_SYSTEM              0x1000
 800 #define MYIMAGE_FILE_BYTES_REVERSED_HI   0x8000
 801 #define MYIMAGE_FILE_BYTES_REVERSED_LO   0x0080
 802 #define MYIMAGE_FILE_32BIT_MACHINE       0x0100
 803
 804 /* From PE spec doc, section 5.4.2 and 5.4.4 */
 805 #define MYIMAGE_SYM_CLASS_EXTERNAL       2
 806 #define MYIMAGE_SYM_CLASS_STATIC         3
 807 #define MYIMAGE_SYM_UNDEFINED            0
 808
 809 /* From PE spec doc, section 4.1 */
 810 #define MYIMAGE_SCN_CNT_CODE             0x00000020
 811 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
 812
 813 /* From PE spec doc, section 5.2.1 */
 814 #define MYIMAGE_REL_I386_DIR32           0x0006
 815 #define MYIMAGE_REL_I386_REL32           0x0014
 816
 817
 818 /* We use myindex to calculate array addresses, rather than
 819    simply doing the normal subscript thing.  That's because
 820    some of the above structs have sizes which are not
 821    a whole number of words.  GCC rounds their sizes up to a
 822    whole number of words, which means that the address calcs
 823    arising from using normal C indexing or pointer arithmetic
 824    are just plain wrong.  Sigh.
 825 */
 826 static UChar *
 827 myindex ( int scale, void* base, int index )
 828 {
 829    return
 830       ((UChar*)base) + scale * index;
 831 }
 832
 833
 834 static void
 835 printName ( UChar* name, UChar* strtab )
 836 {
 837    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 838       UInt32 strtab_offset = * (UInt32*)(name+4);
 839       fprintf ( stderr, "%s", strtab + strtab_offset );
 840    } else {
 841       int i;
 842       for (i = 0; i < 8; i++) {
 843          if (name[i] == 0) break;
 844          fprintf ( stderr, "%c", name[i] );
 845       }
 846    }
 847 }
 848
 849
 850 static void
 851 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
 852 {
 853    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 854       UInt32 strtab_offset = * (UInt32*)(name+4);
 855       strncpy ( dst, strtab+strtab_offset, dstSize );
 856       dst[dstSize-1] = 0;
 857    } else {
 858       int i = 0;
 859       while (1) {
 860          if (i >= 8) break;
 861          if (name[i] == 0) break;
 862          dst[i] = name[i];
 863          i++;
 864       }
 865       dst[i] = 0;
 866    }
 867 }
 868
 869
 870 static UChar *
 871 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
 872 {
 873    UChar* newstr;
 874    /* If the string is longer than 8 bytes, look in the
 875       string table for it -- this will be correctly zero terminated.
 876    */
 877    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 878       UInt32 strtab_offset = * (UInt32*)(name+4);
 879       return ((UChar*)strtab) + strtab_offset;
 880    }
 881    /* Otherwise, if shorter than 8 bytes, return the original,
 882       which by defn is correctly terminated.
 883    */
 884    if (name[7]==0) return name;
 885    /* The annoying case: 8 bytes.  Copy into a temporary
 886       (which is never freed ...)
 887    */
 888    newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
 889    ASSERT(newstr);
 890    strncpy(newstr,name,8);
 891    newstr[8] = 0;
 892    return newstr;
 893 }
 894
 895
 896 /* Just compares the short names (first 8 chars) */
 897 static COFF_section *
 898 findPEi386SectionCalled ( ObjectCode* oc,  char* name )
 899 {
 900    int i;
 901    COFF_header* hdr
 902       = (COFF_header*)(oc->image);
 903    COFF_section* sectab
 904       = (COFF_section*) (
 905            ((UChar*)(oc->image))
 906            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 907         );
 908    for (i = 0; i < hdr->NumberOfSections; i++) {
 909       UChar* n1;
 910       UChar* n2;
 911       COFF_section* section_i
 912          = (COFF_section*)
 913            myindex ( sizeof_COFF_section, sectab, i );
 914       n1 = (UChar*) &(section_i->Name);
 915       n2 = name;
 916       if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
 917           n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
 918           n1[6]==n2[6] && n1[7]==n2[7])
 919          return section_i;
 920    }
 921
 922    return NULL;
 923 }
 924
 925
 926 static void
 927 zapTrailingAtSign ( UChar* sym )
 928 {
 929 #  define my_isdigit(c) ((c) >= '0' && (c) <= '9')
 930    int i, j;
 931    if (sym[0] == 0) return;
 932    i = 0;
 933    while (sym[i] != 0) i++;
 934    i--;
 935    j = i;
 936    while (j > 0 && my_isdigit(sym[j])) j--;
 937    if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
 938 #  undef my_isdigit
 939 }
 940
 941
 942 static int
 943 ocVerifyImage_PEi386 ( ObjectCode* oc )
 944 {
 945    int i, j;
 946    COFF_header*  hdr;
 947    COFF_section* sectab;
 948    COFF_symbol*  symtab;
 949    UChar*        strtab;
 950    /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
 951    hdr = (COFF_header*)(oc->image);
 952    sectab = (COFF_section*) (
 953                ((UChar*)(oc->image))
 954                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 955             );
 956    symtab = (COFF_symbol*) (
 957                ((UChar*)(oc->image))
 958                + hdr->PointerToSymbolTable
 959             );
 960    strtab = ((UChar*)symtab)
 961             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 962
 963    if (hdr->Machine != 0x14c) {
 964       belch("Not x86 PEi386");
 965       return 0;
 966    }
 967    if (hdr->SizeOfOptionalHeader != 0) {
 968       belch("PEi386 with nonempty optional header");
 969       return 0;
 970    }
 971    if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
 972         (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
 973         (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
 974         (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
 975       belch("Not a PEi386 object file");
 976       return 0;
 977    }
 978    if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
 979         /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
 980       belch("Invalid PEi386 word size or endiannness: %d",
 981             (int)(hdr->Characteristics));
 982       return 0;
 983    }
 984    /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
 985    if (* (UInt32*)strtab > 510000) {
 986       belch("PEi386 object has suspiciously large string table; > 64k relocs?");
 987       return 0;
 988    }
 989
 990    /* No further verification after this point; only debug printing. */
 991    i = 0;
 992    IF_DEBUG(linker, i=1);
 993    if (i == 0) return 1;
 994
 995    fprintf ( stderr,
 996              "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
 997    fprintf ( stderr,
 998              "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
 999    fprintf ( stderr,
1000              "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1001
1002    fprintf ( stderr, "\n" );
1003    fprintf ( stderr,
1004              "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
1005    fprintf ( stderr,
1006              "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
1007    fprintf ( stderr,
1008              "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1009    fprintf ( stderr,
1010              "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
1011    fprintf ( stderr,
1012              "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
1013    fprintf ( stderr,
1014              "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
1015    fprintf ( stderr,
1016              "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
1017
1018    /* Print the section table. */
1019    fprintf ( stderr, "\n" );
1020    for (i = 0; i < hdr->NumberOfSections; i++) {
1021       COFF_reloc* reltab;
1022       COFF_section* sectab_i
1023          = (COFF_section*)
1024            myindex ( sizeof_COFF_section, sectab, i );
1025       fprintf ( stderr,
1026                 "\n"
1027                 "section %d\n"
1028                 "     name `",
1029                 i
1030               );
1031       printName ( sectab_i->Name, strtab );
1032       fprintf ( stderr,
1033                 "'\n"
1034                 "    vsize %d\n"
1035                 "    vaddr %d\n"
1036                 "  data sz %d\n"
1037                 " data off %d\n"
1038                 "  num rel %d\n"
1039                 "  off rel %d\n",
1040                 sectab_i->VirtualSize,
1041                 sectab_i->VirtualAddress,
1042                 sectab_i->SizeOfRawData,
1043                 sectab_i->PointerToRawData,
1044                 sectab_i->NumberOfRelocations,
1045                 sectab_i->PointerToRelocations
1046               );
1047       reltab = (COFF_reloc*) (
1048                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1049                );
1050
1051       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1052          COFF_symbol* sym;
1053          COFF_reloc* rel = (COFF_reloc*)
1054                            myindex ( sizeof_COFF_reloc, reltab, j );
1055          fprintf ( stderr,
1056                    "        type 0x%-4x   vaddr 0x%-8x   name `",
1057                    (UInt32)rel->Type,
1058                    rel->VirtualAddress );
1059          sym = (COFF_symbol*)
1060                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1061          printName ( sym->Name, strtab -10 );
1062          fprintf ( stderr, "'\n" );
1063       }
1064       fprintf ( stderr, "\n" );
1065    }
1066
1067    fprintf ( stderr, "\n" );
1068    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1069    fprintf ( stderr, "---START of string table---\n");
1070    for (i = 4; i < *(Int32*)strtab; i++) {
1071       if (strtab[i] == 0)
1072          fprintf ( stderr, "\n"); else
1073          fprintf( stderr, "%c", strtab[i] );
1074    }
1075    fprintf ( stderr, "--- END  of string table---\n");
1076
1077    fprintf ( stderr, "\n" );
1078    i = 0;
1079    while (1) {
1080       COFF_symbol* symtab_i;
1081       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1082       symtab_i = (COFF_symbol*)
1083                  myindex ( sizeof_COFF_symbol, symtab, i );
1084       fprintf ( stderr,
1085                 "symbol %d\n"
1086                 "     name `",
1087                 i
1088               );
1089       printName ( symtab_i->Name, strtab );
1090       fprintf ( stderr,
1091                 "'\n"
1092                 "    value 0x%x\n"
1093                 "     sec# %d\n"
1094                 "     type 0x%x\n"
1095                 "   sclass 0x%x\n"
1096                 "     nAux %d\n",
1097                 symtab_i->Value,
1098                 (Int32)(symtab_i->SectionNumber) - 1,
1099                 (UInt32)symtab_i->Type,
1100                 (UInt32)symtab_i->StorageClass,
1101                 (UInt32)symtab_i->NumberOfAuxSymbols
1102               );
1103       i += symtab_i->NumberOfAuxSymbols;
1104       i++;
1105    }
1106
1107    fprintf ( stderr, "\n" );
1108    return 1;
1109 }
1110
1111
1112 static int
1113 ocGetNames_PEi386 ( ObjectCode* oc )
1114 {
1115    COFF_header*  hdr;
1116    COFF_section* sectab;
1117    COFF_symbol*  symtab;
1118    UChar*        strtab;
1119
1120    UChar* sname;
1121    void*  addr;
1122    int    i;
1123
1124    hdr = (COFF_header*)(oc->image);
1125    sectab = (COFF_section*) (
1126                ((UChar*)(oc->image))
1127                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1128             );
1129    symtab = (COFF_symbol*) (
1130                ((UChar*)(oc->image))
1131                + hdr->PointerToSymbolTable
1132             );
1133    strtab = ((UChar*)(oc->image))
1134             + hdr->PointerToSymbolTable
1135             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1136
1137    /* Copy exported symbols into the ObjectCode. */
1138
1139    oc->n_symbols = hdr->NumberOfSymbols;
1140    oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
1141                                   "ocGetNames_PEi386(oc->symbols)");
1142    /* Call me paranoid; I don't care. */
1143    for (i = 0; i < oc->n_symbols; i++)
1144       oc->symbols[i] = NULL;
1145
1146    i = 0;
1147    while (1) {
1148       COFF_symbol* symtab_i;
1149       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1150       symtab_i = (COFF_symbol*)
1151                  myindex ( sizeof_COFF_symbol, symtab, i );
1152
1153       if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL &&
1154           symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1155
1156          /* This symbol is global and defined, viz, exported */
1157          COFF_section* sectabent;
1158
1159          /* cstring_from_COFF_symbol_name always succeeds. */
1160          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1161
1162          /* for MYIMAGE_SYMCLASS_EXTERNAL
1163                 && !MYIMAGE_SYM_UNDEFINED,
1164             the address of the symbol is:
1165                 address of relevant section + offset in section
1166          */
1167          sectabent = (COFF_section*)
1168                      myindex ( sizeof_COFF_section,
1169                                sectab,
1170                                symtab_i->SectionNumber-1 );
1171          addr = ((UChar*)(oc->image))
1172                 + (sectabent->PointerToRawData
1173                    + symtab_i->Value);
1174          /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */
1175          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1176          ASSERT(i >= 0 && i < oc->n_symbols);
1177          oc->symbols[i] = sname;
1178          insertStrHashTable(symhash, sname, addr);
1179       }
1180       i += symtab_i->NumberOfAuxSymbols;
1181       i++;
1182    }
1183
1184    /* Copy section information into the ObjectCode. */
1185
1186    oc->n_sections = hdr->NumberOfSections;
1187    oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section),
1188                                   "ocGetNamesPEi386" );
1189
1190    for (i = 0; i < oc->n_sections; i++) {
1191       UChar* start;
1192       UChar* end;
1193
1194       SectionKind kind
1195          = SECTIONKIND_OTHER;
1196       COFF_section* sectab_i
1197          = (COFF_section*)
1198            myindex ( sizeof_COFF_section, sectab, i );
1199       IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1200
1201 #if 0
1202       /* I'm sure this is the Right Way to do it.  However, the
1203          alternative of testing the sectab_i->Name field seems to
1204          work ok with Cygwin.
1205       */
1206       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
1207           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1208          kind = SECTIONKIND_CODE_OR_RODATA;
1209 #endif
1210
1211       if (0==strcmp(".text",sectab_i->Name) ||
1212           0==strcmp(".rodata",sectab_i->Name))
1213          kind = SECTIONKIND_CODE_OR_RODATA;
1214       if (0==strcmp(".data",sectab_i->Name) ||
1215           0==strcmp(".bss",sectab_i->Name))
1216          kind = SECTIONKIND_RWDATA;
1217
1218       start = ((UChar*)(oc->image))
1219               + sectab_i->PointerToRawData;
1220       end   = start
1221               + sectab_i->SizeOfRawData - 1;
1222
1223       if (kind == SECTIONKIND_OTHER) {
1224          belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1225          return 0;
1226       }
1227
1228       oc->sections[i].start = start;
1229       oc->sections[i].end   = end;
1230       oc->sections[i].kind  = kind;
1231    }
1232
1233    return 1;
1234 }
1235
1236
1237 static int
1238 ocResolve_PEi386 ( ObjectCode* oc )
1239 {
1240    COFF_header*  hdr;
1241    COFF_section* sectab;
1242    COFF_symbol*  symtab;
1243    UChar*        strtab;
1244
1245    UInt32        A;
1246    UInt32        S;
1247    UInt32*       pP;
1248
1249    int i, j;
1250
1251    /* ToDo: should be variable-sized?  But is at least safe in the
1252       sense of buffer-overrun-proof. */
1253    char symbol[1000];
1254    /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1255
1256    hdr = (COFF_header*)(oc->image);
1257    sectab = (COFF_section*) (
1258                ((UChar*)(oc->image))
1259                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1260             );
1261    symtab = (COFF_symbol*) (
1262                ((UChar*)(oc->image))
1263                + hdr->PointerToSymbolTable
1264             );
1265    strtab = ((UChar*)(oc->image))
1266             + hdr->PointerToSymbolTable
1267             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1268
1269    for (i = 0; i < hdr->NumberOfSections; i++) {
1270       COFF_section* sectab_i
1271          = (COFF_section*)
1272            myindex ( sizeof_COFF_section, sectab, i );
1273       COFF_reloc* reltab
1274          = (COFF_reloc*) (
1275               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1276            );
1277       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1278          COFF_symbol* sym;
1279          COFF_reloc* reltab_j
1280             = (COFF_reloc*)
1281               myindex ( sizeof_COFF_reloc, reltab, j );
1282
1283          /* the location to patch */
1284          pP = (UInt32*)(
1285                  ((UChar*)(oc->image))
1286                  + (sectab_i->PointerToRawData
1287                     + reltab_j->VirtualAddress
1288                     - sectab_i->VirtualAddress )
1289               );
1290          /* the existing contents of pP */
1291          A = *pP;
1292          /* the symbol to connect to */
1293          sym = (COFF_symbol*)
1294                myindex ( sizeof_COFF_symbol,
1295                          symtab, reltab_j->SymbolTableIndex );
1296          IF_DEBUG(linker,
1297                   fprintf ( stderr,
1298                             "reloc sec %2d num %3d:  type 0x%-4x   "
1299                             "vaddr 0x%-8x   name `",
1300                             i, j,
1301                             (UInt32)reltab_j->Type,
1302                             reltab_j->VirtualAddress );
1303                             printName ( sym->Name, strtab );
1304                             fprintf ( stderr, "'\n" ));
1305
1306          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1307             COFF_section* section_sym
1308                = findPEi386SectionCalled ( oc, sym->Name );
1309             if (!section_sym) {
1310                belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1311                return 0;
1312             }
1313             S = ((UInt32)(oc->image))
1314                 + (section_sym->PointerToRawData
1315                    + sym->Value);
1316          } else {
1317             copyName ( sym->Name, strtab, symbol, 1000-1 );
1318             zapTrailingAtSign ( symbol );
1319             (void*)S = lookupLocalSymbol( oc, symbol );
1320             if ((void*)S == NULL)
1321                (void*)S = lookupSymbol( symbol );
1322             if (S == 0) {
1323                 belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1324                 return 0;
1325             }
1326          }
1327
1328          switch (reltab_j->Type) {
1329             case MYIMAGE_REL_I386_DIR32:
1330                *pP = A + S;
1331                break;
1332             case MYIMAGE_REL_I386_REL32:
1333                /* Tricky.  We have to insert a displacement at
1334                   pP which, when added to the PC for the _next_
1335                   insn, gives the address of the target (S).
1336                   Problem is to know the address of the next insn
1337                   when we only know pP.  We assume that this
1338                   literal field is always the last in the insn,
1339                   so that the address of the next insn is pP+4
1340                   -- hence the constant 4.
1341                   Also I don't know if A should be added, but so
1342                   far it has always been zero.
1343                */
1344                ASSERT(A==0);
1345                *pP = S - ((UInt32)pP) - 4;
1346                break;
1347             default:
1348                belch("%s: unhandled PEi386 relocation type %d",
1349                      oc->fileName, reltab_j->Type);
1350                return 0;
1351          }
1352
1353       }
1354    }
1355
1356    IF_DEBUG(linker, belch("completed %s", oc->fileName));
1357    return 1;
1358 }
1359
1360 #endif /* defined(OBJFORMAT_PEi386) */
1361
1362
1363 /* --------------------------------------------------------------------------
1364  * ELF specifics
1365  * ------------------------------------------------------------------------*/
1366
1367 #if defined(OBJFORMAT_ELF)
1368
1369 #define FALSE 0
1370 #define TRUE  1
1371
1372 #if defined(sparc_TARGET_ARCH)
1373 #  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
1374 #elif defined(i386_TARGET_ARCH)
1375 #  define ELF_TARGET_386    /* Used inside <elf.h> */
1376 #endif
1377 /* There is a similar case for IA64 in the Solaris2 headers if this
1378  * ever becomes relevant.
1379  */
1380
1381 #include <elf.h>
1382
1383 static char *
1384 findElfSection ( void* objImage, Elf32_Word sh_type )
1385 {
1386    int i;
1387    char* ehdrC = (char*)objImage;
1388    Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1389    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1390    char* ptr = NULL;
1391    for (i = 0; i < ehdr->e_shnum; i++) {
1392       if (shdr[i].sh_type == sh_type &&
1393           i !=  ehdr->e_shstrndx) {
1394          ptr = ehdrC + shdr[i].sh_offset;
1395          break;
1396       }
1397    }
1398    return ptr;
1399 }
1400
1401
1402 static int
1403 ocVerifyImage_ELF ( ObjectCode* oc )
1404 {
1405    Elf32_Shdr* shdr;
1406    Elf32_Sym*  stab;
1407    int i, j, nent, nstrtab, nsymtabs;
1408    char* sh_strtab;
1409    char* strtab;
1410
1411    char*       ehdrC = (char*)(oc->image);
1412    Elf32_Ehdr* ehdr  = ( Elf32_Ehdr*)ehdrC;
1413
1414    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1415        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1416        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1417        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1418       belch("%s: not an ELF header", oc->fileName);
1419       return 0;
1420    }
1421    IF_DEBUG(linker,belch( "Is an ELF header" ));
1422
1423    if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1424       belch("%s: not 32 bit ELF", oc->fileName);
1425       return 0;
1426    }
1427
1428    IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1429
1430    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1431        IF_DEBUG(linker,belch( "Is little-endian" ));
1432    } else
1433    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1434        IF_DEBUG(linker,belch( "Is big-endian" ));
1435    } else {
1436        belch("%s: unknown endiannness", oc->fileName);
1437        return 0;
1438    }
1439
1440    if (ehdr->e_type != ET_REL) {
1441       belch("%s: not a relocatable object (.o) file", oc->fileName);
1442       return 0;
1443    }
1444    IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1445
1446    IF_DEBUG(linker,belch( "Architecture is " ));
1447    switch (ehdr->e_machine) {
1448       case EM_386:   IF_DEBUG(linker,belch( "x86" )); break;
1449       case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1450       default:       IF_DEBUG(linker,belch( "unknown" ));
1451                      belch("%s: unknown architecture", oc->fileName);
1452                      return 0;
1453    }
1454
1455    IF_DEBUG(linker,belch(
1456              "\nSection header table: start %d, n_entries %d, ent_size %d",
1457              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
1458
1459    ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1460
1461    shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1462
1463    if (ehdr->e_shstrndx == SHN_UNDEF) {
1464       belch("%s: no section header string table", oc->fileName);
1465       return 0;
1466    } else {
1467       IF_DEBUG(linker,belch( "Section header string table is section %d",
1468                           ehdr->e_shstrndx));
1469       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1470    }
1471
1472    for (i = 0; i < ehdr->e_shnum; i++) {
1473       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
1474       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", (int)shdr[i].sh_type ));
1475       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", (int)shdr[i].sh_size ));
1476       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", (int)shdr[i].sh_offset ));
1477       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
1478                ehdrC + shdr[i].sh_offset,
1479                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1480
1481       if (shdr[i].sh_type == SHT_REL) {
1482           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
1483       } else if (shdr[i].sh_type == SHT_RELA) {
1484           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1485       } else {
1486           IF_DEBUG(linker,fprintf(stderr,"     "));
1487       }
1488       if (sh_strtab) {
1489           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1490       }
1491    }
1492
1493    IF_DEBUG(linker,belch( "\nString tables" ));
1494    strtab = NULL;
1495    nstrtab = 0;
1496    for (i = 0; i < ehdr->e_shnum; i++) {
1497       if (shdr[i].sh_type == SHT_STRTAB &&
1498           i !=  ehdr->e_shstrndx) {
1499           IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
1500          strtab = ehdrC + shdr[i].sh_offset;
1501          nstrtab++;
1502       }
1503    }
1504    if (nstrtab != 1) {
1505       belch("%s: no string tables, or too many", oc->fileName);
1506       return 0;
1507    }
1508
1509    nsymtabs = 0;
1510    IF_DEBUG(linker,belch( "\nSymbol tables" ));
1511    for (i = 0; i < ehdr->e_shnum; i++) {
1512       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1513       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1514       nsymtabs++;
1515       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1516       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1517       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
1518                nent,
1519                shdr[i].sh_size % sizeof(Elf32_Sym)
1520              ));
1521       if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1522          belch("%s: non-integral number of symbol table entries", oc->fileName);
1523          return 0;
1524       }
1525       for (j = 0; j < nent; j++) {
1526          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
1527          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ",
1528                              (int)stab[j].st_shndx,
1529                              (int)stab[j].st_size,
1530                              (char*)stab[j].st_value ));
1531
1532          IF_DEBUG(linker,fprintf(stderr, "type=" ));
1533          switch (ELF32_ST_TYPE(stab[j].st_info)) {
1534             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1535             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1536             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
1537             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1538             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
1539             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
1540          }
1541          IF_DEBUG(linker,fprintf(stderr, "  " ));
1542
1543          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1544          switch (ELF32_ST_BIND(stab[j].st_info)) {
1545             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1546             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1547             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
1548             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
1549          }
1550          IF_DEBUG(linker,fprintf(stderr, "  " ));
1551
1552          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1553       }
1554    }
1555
1556    if (nsymtabs == 0) {
1557       belch("%s: didn't find any symbol tables", oc->fileName);
1558       return 0;
1559    }
1560
1561    return 1;
1562 }
1563
1564
1565 static int
1566 ocGetNames_ELF ( ObjectCode* oc )
1567 {
1568    int i, j, k, nent;
1569    Elf32_Sym* stab;
1570
1571    char*       ehdrC      = (char*)(oc->image);
1572    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
1573    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
1574    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1575    char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1576
1577    ASSERT(symhash != NULL);
1578
1579    if (!strtab) {
1580       belch("%s: no strtab", oc->fileName);
1581       return 0;
1582    }
1583
1584    k = 0;
1585    oc->n_sections = ehdr->e_shnum;
1586    oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section),
1587                                   "ocGetNames_ELF(oc->sections)" );
1588
1589    for (i = 0; i < oc->n_sections; i++) {
1590
1591       /* make a section entry for relevant sections */
1592       SectionKind kind = SECTIONKIND_OTHER;
1593       if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
1594           !strcmp(".data1",sh_strtab+shdr[i].sh_name))
1595           kind = SECTIONKIND_RWDATA;
1596       if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
1597           !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
1598           !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
1599           kind = SECTIONKIND_CODE_OR_RODATA;
1600
1601       /* fill in the section info */
1602       oc->sections[i].start = ehdrC + shdr[i].sh_offset;
1603       oc->sections[i].end   = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
1604       oc->sections[i].kind  = kind;
1605
1606       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1607
1608       /* copy stuff into this module's object symbol table */
1609       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1610       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1611
1612       oc->n_symbols = nent;
1613       oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1614                                    "ocGetNames_ELF(oc->symbols)");
1615
1616       for (j = 0; j < nent; j++) {
1617          if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1618                 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1619               )
1620               /* and not an undefined symbol */
1621               && stab[j].st_shndx != SHN_UNDEF
1622               /* and not in a "special section" */
1623               && stab[j].st_shndx < SHN_LORESERVE
1624               &&
1625               /* and it's a not a section or string table or anything silly */
1626               ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1627                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1628                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE
1629               )
1630             ) {
1631             char* nm = strtab + stab[j].st_name;
1632             char* ad = ehdrC
1633                        + shdr[ stab[j].st_shndx ].sh_offset
1634                        + stab[j].st_value;
1635             ASSERT(nm != NULL);
1636             ASSERT(ad != NULL);
1637             oc->symbols[j] = nm;
1638             if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
1639                IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p  %s %s",
1640                                       ad, oc->fileName, nm ));
1641                insertStrHashTable(oc->lochash, nm, ad);
1642             } else {
1643                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
1644                                       ad, oc->fileName, nm ));
1645                insertStrHashTable(symhash, nm, ad);
1646             }
1647          }
1648          else {
1649             IF_DEBUG(linker,belch( "skipping `%s'",
1650                                    strtab + stab[j].st_name ));
1651             /*
1652             fprintf(stderr,
1653                     "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
1654                     (int)ELF32_ST_BIND(stab[j].st_info),
1655                     (int)ELF32_ST_TYPE(stab[j].st_info),
1656                     (int)stab[j].st_shndx,
1657                     strtab + stab[j].st_name
1658                    );
1659             */
1660             oc->symbols[j] = NULL;
1661          }
1662       }
1663    }
1664
1665    return 1;
1666 }
1667
1668
1669 /* Do ELF relocations which lack an explicit addend.  All x86-linux
1670    relocations appear to be of this form. */
1671 static int
1672 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             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1718             return 0;
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             belch("%s: unhandled ELF relocation(Rel) type %d\n",
1731                   oc->fileName, ELF32_R_TYPE(info));
1732             return 0;
1733       }
1734
1735    }
1736    return 1;
1737 }
1738
1739
1740 /* Do ELF relocations for which explicit addends are supplied.
1741    sparc-solaris relocations appear to be of this form. */
1742 static int
1743 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            belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1795            return 0;
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          /* According to the Sun documentation:
1829             R_SPARC_UA32
1830             This relocation type resembles R_SPARC_32, except it refers to an
1831             unaligned word. That is, the word to be relocated must be treated
1832             as four separate bytes with arbitrary alignment, not as a word
1833             aligned according to the architecture requirements.
1834
1835             (JRS: which means that freeloading on the R_SPARC_32 case
1836             is probably wrong, but hey ...)
1837          */
1838          case R_SPARC_UA32:
1839          case R_SPARC_32:
1840             w2 = (Elf32_Word)(S + A);
1841             *pP = w2;
1842             break;
1843 #        endif
1844          default:
1845             belch("%s: unhandled ELF relocation(RelA) type %d\n",
1846                   oc->fileName, ELF32_R_TYPE(info));
1847             return 0;
1848       }
1849
1850    }
1851    return 1;
1852 }
1853
1854
1855 static int
1856 ocResolve_ELF ( ObjectCode* oc )
1857 {
1858    char *strtab;
1859    int   shnum, ok;
1860    Elf32_Sym*  stab = NULL;
1861    char*       ehdrC = (char*)(oc->image);
1862    Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
1863    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1864
1865    /* first find "the" symbol table */
1866    stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
1867
1868    /* also go find the string table */
1869    strtab = findElfSection ( ehdrC, SHT_STRTAB );
1870
1871    if (stab == NULL || strtab == NULL) {
1872       belch("%s: can't find string or symbol table", oc->fileName);
1873       return 0;
1874    }
1875
1876    /* Process the relocation sections. */
1877    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
1878       if (shdr[shnum].sh_type == SHT_REL ) {
1879          ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
1880                                          shnum, stab, strtab );
1881          if (!ok) return ok;
1882       }
1883       else
1884       if (shdr[shnum].sh_type == SHT_RELA) {
1885          ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
1886                                           shnum, stab, strtab );
1887          if (!ok) return ok;
1888       }
1889    }
1890
1891    /* Free the local symbol table; we won't need it again. */
1892    freeHashTable(oc->lochash, NULL);
1893    oc->lochash = NULL;
1894
1895    return 1;
1896 }
1897
1898
1899 #endif /* ELF */