ghc/rts/Linker.c

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