ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.52 2001/07/20 01:05:11 sof 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 #endif
1372
1373 #include <elf.h>
1374
1375 static char *
1376 findElfSection ( void* objImage, Elf32_Word sh_type )
1377 {
1378    int i;
1379    char* ehdrC = (char*)objImage;
1380    Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1381    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1382    char* ptr = NULL;
1383    for (i = 0; i < ehdr->e_shnum; i++) {
1384       if (shdr[i].sh_type == sh_type &&
1385           i !=  ehdr->e_shstrndx) {
1386          ptr = ehdrC + shdr[i].sh_offset;
1387          break;
1388       }
1389    }
1390    return ptr;
1391 }
1392
1393
1394 static int
1395 ocVerifyImage_ELF ( ObjectCode* oc )
1396 {
1397    Elf32_Shdr* shdr;
1398    Elf32_Sym*  stab;
1399    int i, j, nent, nstrtab, nsymtabs;
1400    char* sh_strtab;
1401    char* strtab;
1402
1403    char*       ehdrC = (char*)(oc->image);
1404    Elf32_Ehdr* ehdr  = ( Elf32_Ehdr*)ehdrC;
1405
1406    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1407        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1408        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1409        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1410       belch("ocVerifyImage_ELF: not an ELF header");
1411       return 0;
1412    }
1413    IF_DEBUG(linker,belch( "Is an ELF header" ));
1414
1415    if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1416       belch("ocVerifyImage_ELF: not 32 bit ELF" );
1417       return 0;
1418    }
1419
1420    IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1421
1422    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1423        IF_DEBUG(linker,belch( "Is little-endian" ));
1424    } else
1425    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1426        IF_DEBUG(linker,belch( "Is big-endian" ));
1427    } else {
1428        belch("ocVerifyImage_ELF: unknown endiannness");
1429        return 0;
1430    }
1431
1432    if (ehdr->e_type != ET_REL) {
1433       belch("ocVerifyImage_ELF: not a relocatable object (.o) file");
1434       return 0;
1435    }
1436    IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1437
1438    IF_DEBUG(linker,belch( "Architecture is " ));
1439    switch (ehdr->e_machine) {
1440       case EM_386:   IF_DEBUG(linker,belch( "x86" )); break;
1441       case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1442       default:       IF_DEBUG(linker,belch( "unknown" ));
1443                      belch("ocVerifyImage_ELF: unknown architecture");
1444                      return 0;
1445    }
1446
1447    IF_DEBUG(linker,belch(
1448              "\nSection header table: start %d, n_entries %d, ent_size %d",
1449              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
1450
1451    ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1452
1453    shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1454
1455    if (ehdr->e_shstrndx == SHN_UNDEF) {
1456       belch("ocVerifyImage_ELF: no section header string table");
1457       return 0;
1458    } else {
1459       IF_DEBUG(linker,belch( "Section header string table is section %d",
1460                           ehdr->e_shstrndx));
1461       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1462    }
1463
1464    for (i = 0; i < ehdr->e_shnum; i++) {
1465       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
1466       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", (int)shdr[i].sh_type ));
1467       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", (int)shdr[i].sh_size ));
1468       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", (int)shdr[i].sh_offset ));
1469       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
1470                ehdrC + shdr[i].sh_offset,
1471                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1472
1473       if (shdr[i].sh_type == SHT_REL) {
1474           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
1475       } else if (shdr[i].sh_type == SHT_RELA) {
1476           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1477       } else {
1478           IF_DEBUG(linker,fprintf(stderr,"     "));
1479       }
1480       if (sh_strtab) {
1481           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1482       }
1483    }
1484
1485    IF_DEBUG(linker,belch( "\nString tables" ));
1486    strtab = NULL;
1487    nstrtab = 0;
1488    for (i = 0; i < ehdr->e_shnum; i++) {
1489       if (shdr[i].sh_type == SHT_STRTAB &&
1490           i !=  ehdr->e_shstrndx) {
1491           IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
1492          strtab = ehdrC + shdr[i].sh_offset;
1493          nstrtab++;
1494       }
1495    }
1496    if (nstrtab != 1) {
1497       belch("ocVerifyImage_ELF: no string tables, or too many");
1498       return 0;
1499    }
1500
1501    nsymtabs = 0;
1502    IF_DEBUG(linker,belch( "\nSymbol tables" ));
1503    for (i = 0; i < ehdr->e_shnum; i++) {
1504       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1505       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1506       nsymtabs++;
1507       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1508       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1509       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
1510                nent,
1511                shdr[i].sh_size % sizeof(Elf32_Sym)
1512              ));
1513       if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1514          belch("ocVerifyImage_ELF: non-integral number of symbol table entries");
1515          return 0;
1516       }
1517       for (j = 0; j < nent; j++) {
1518          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
1519          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ",
1520                              (int)stab[j].st_shndx,
1521                              (int)stab[j].st_size,
1522                              (char*)stab[j].st_value ));
1523
1524          IF_DEBUG(linker,fprintf(stderr, "type=" ));
1525          switch (ELF32_ST_TYPE(stab[j].st_info)) {
1526             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1527             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1528             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
1529             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1530             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
1531             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
1532          }
1533          IF_DEBUG(linker,fprintf(stderr, "  " ));
1534
1535          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1536          switch (ELF32_ST_BIND(stab[j].st_info)) {
1537             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1538             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1539             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
1540             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
1541          }
1542          IF_DEBUG(linker,fprintf(stderr, "  " ));
1543
1544          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1545       }
1546    }
1547
1548    if (nsymtabs == 0) {
1549       belch("ocVerifyImage_ELF: didn't find any symbol tables");
1550       return 0;
1551    }
1552
1553    return 1;
1554 }
1555
1556
1557 static int
1558 ocGetNames_ELF ( ObjectCode* oc )
1559 {
1560    int i, j, k, nent;
1561    Elf32_Sym* stab;
1562
1563    char*       ehdrC      = (char*)(oc->image);
1564    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
1565    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
1566    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1567    char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1568
1569    ASSERT(symhash != NULL);
1570
1571    if (!strtab) {
1572       belch("ocGetNames_ELF: no strtab");
1573       return 0;
1574    }
1575
1576    k = 0;
1577    oc->n_sections = ehdr->e_shnum;
1578    oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section),
1579                                   "ocGetNames_ELF(oc->sections)" );
1580
1581    for (i = 0; i < oc->n_sections; i++) {
1582
1583       /* make a section entry for relevant sections */
1584       SectionKind kind = SECTIONKIND_OTHER;
1585       if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
1586           !strcmp(".data1",sh_strtab+shdr[i].sh_name))
1587           kind = SECTIONKIND_RWDATA;
1588       if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
1589           !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
1590           !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
1591           kind = SECTIONKIND_CODE_OR_RODATA;
1592
1593       /* fill in the section info */
1594       oc->sections[i].start = ehdrC + shdr[i].sh_offset;
1595       oc->sections[i].end   = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
1596       oc->sections[i].kind  = kind;
1597
1598       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1599
1600       /* copy stuff into this module's object symbol table */
1601       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1602       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1603
1604       oc->n_symbols = nent;
1605       oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1606                                    "ocGetNames_ELF(oc->symbols)");
1607
1608       for (j = 0; j < nent; j++) {
1609          if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1610                 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1611               )
1612               /* and not an undefined symbol */
1613               && stab[j].st_shndx != SHN_UNDEF
1614               /* and not in a "special section" */
1615               && stab[j].st_shndx < SHN_LORESERVE
1616               &&
1617               /* and it's a not a section or string table or anything silly */
1618               ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1619                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1620                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE
1621               )
1622             ) {
1623             char* nm = strtab + stab[j].st_name;
1624             char* ad = ehdrC
1625                        + shdr[ stab[j].st_shndx ].sh_offset
1626                        + stab[j].st_value;
1627             ASSERT(nm != NULL);
1628             ASSERT(ad != NULL);
1629             oc->symbols[j] = nm;
1630             if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
1631                IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p  %s %s",
1632                                       ad, oc->fileName, nm ));
1633                insertStrHashTable(oc->lochash, nm, ad);
1634             } else {
1635                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
1636                                       ad, oc->fileName, nm ));
1637                insertStrHashTable(symhash, nm, ad);
1638             }
1639          }
1640          else {
1641             IF_DEBUG(linker,belch( "skipping `%s'",
1642                                    strtab + stab[j].st_name ));
1643             /*
1644             fprintf(stderr,
1645                     "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
1646                     (int)ELF32_ST_BIND(stab[j].st_info),
1647                     (int)ELF32_ST_TYPE(stab[j].st_info),
1648                     (int)stab[j].st_shndx,
1649                     strtab + stab[j].st_name
1650                    );
1651             */
1652             oc->symbols[j] = NULL;
1653          }
1654       }
1655    }
1656
1657    return 1;
1658 }
1659
1660
1661 /* Do ELF relocations which lack an explicit addend.  All x86-linux
1662    relocations appear to be of this form. */
1663 static int do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
1664                                       Elf32_Shdr* shdr, int shnum,
1665                                       Elf32_Sym*  stab, char* strtab )
1666 {
1667    int j;
1668    char *symbol;
1669    Elf32_Word* targ;
1670    Elf32_Rel*  rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset);
1671    int         nent = shdr[shnum].sh_size / sizeof(Elf32_Rel);
1672    int target_shndx = shdr[shnum].sh_info;
1673    int symtab_shndx = shdr[shnum].sh_link;
1674    stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1675    targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1676    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1677                           target_shndx, symtab_shndx ));
1678    for (j = 0; j < nent; j++) {
1679       Elf32_Addr offset = rtab[j].r_offset;
1680       Elf32_Word info   = rtab[j].r_info;
1681
1682       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
1683       Elf32_Word* pP = (Elf32_Word*)P;
1684       Elf32_Addr  A  = *pP;
1685       Elf32_Addr  S;
1686
1687       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
1688                              j, (void*)offset, (void*)info ));
1689       if (!info) {
1690          IF_DEBUG(linker,belch( " ZERO" ));
1691          S = 0;
1692       } else {
1693          /* First see if it is a nameless local symbol. */
1694          if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1695             symbol = "(noname)";
1696             S = (Elf32_Addr)
1697                 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1698                        + stab[ELF32_R_SYM(info)].st_value);
1699          } else {
1700             /* No?  Should be in a symbol table then; first try the
1701                local one. */
1702             symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1703             (void*)S = lookupLocalSymbol( oc, symbol );
1704             if ((void*)S == NULL)
1705                (void*)S = lookupSymbol( symbol );
1706          }
1707          if (!S) {
1708             barf("do_Elf32_Rel_relocations:  %s: unknown symbol `%s'",
1709                  oc->fileName, symbol);
1710          }
1711          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1712       }
1713       IF_DEBUG(linker,belch( "Reloc: P = %p   S = %p   A = %p",
1714                              (void*)P, (void*)S, (void*)A ));
1715       switch (ELF32_R_TYPE(info)) {
1716 #        ifdef i386_TARGET_ARCH
1717          case R_386_32:   *pP = S + A;     break;
1718          case R_386_PC32: *pP = S + A - P; break;
1719 #        endif
1720          default:
1721             fprintf(stderr, "unhandled ELF relocation(Rel) type %d\n",
1722                             ELF32_R_TYPE(info));
1723             barf("do_Elf32_Rel_relocations: unhandled ELF relocation type");
1724             return 0;
1725       }
1726
1727    }
1728    return 1;
1729 }
1730
1731
1732 /* Do ELF relocations for which explicit addends are supplied.
1733    sparc-solaris relocations appear to be of this form. */
1734 static int do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
1735                                        Elf32_Shdr* shdr, int shnum,
1736                                        Elf32_Sym*  stab, char* strtab )
1737 {
1738    int j;
1739    char *symbol;
1740    Elf32_Word* targ;
1741    Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset);
1742    int         nent = shdr[shnum].sh_size / sizeof(Elf32_Rela);
1743    int target_shndx = shdr[shnum].sh_info;
1744    int symtab_shndx = shdr[shnum].sh_link;
1745    stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1746    targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1747    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1748                           target_shndx, symtab_shndx ));
1749    for (j = 0; j < nent; j++) {
1750       Elf32_Addr  offset = rtab[j].r_offset;
1751       Elf32_Word  info   = rtab[j].r_info;
1752       Elf32_Sword addend = rtab[j].r_addend;
1753
1754       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
1755       Elf32_Addr  A  = addend;
1756       Elf32_Addr  S;
1757 #     if defined(sparc_TARGET_ARCH)
1758       /* This #ifdef only serves to avoid unused-var warnings. */
1759       Elf32_Word* pP = (Elf32_Word*)P;
1760       Elf32_Word  w1, w2;
1761 #     endif
1762
1763       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p)   ",
1764                              j, (void*)offset, (void*)info,
1765                                 (void*)addend ));
1766       if (!info) {
1767          IF_DEBUG(linker,belch( " ZERO" ));
1768          S = 0;
1769       } else {
1770          /* First see if it is a nameless local symbol. */
1771          if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1772             symbol = "(noname)";
1773             S = (Elf32_Addr)
1774                 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1775                        + stab[ELF32_R_SYM(info)].st_value);
1776          } else {
1777             /* No?  Should be in a symbol table then; first try the
1778                local one. */
1779             symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1780             (void*)S = lookupLocalSymbol( oc, symbol );
1781             if ((void*)S == NULL)
1782                (void*)S = lookupSymbol( symbol );
1783          }
1784          if (!S) {
1785            barf("do_Elf32_Rela_relocations: %s: unknown symbol `%s'",
1786                    oc->fileName, symbol);
1787            /*
1788            S = 0x11223344;
1789            fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
1790            */
1791          }
1792          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1793       }
1794       IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n",
1795                                         (void*)P, (void*)S, (void*)A ));
1796       switch (ELF32_R_TYPE(info)) {
1797 #        if defined(sparc_TARGET_ARCH)
1798          case R_SPARC_WDISP30:
1799             w1 = *pP & 0xC0000000;
1800             w2 = (Elf32_Word)((S + A - P) >> 2);
1801             ASSERT((w2 & 0xC0000000) == 0);
1802             w1 |= w2;
1803             *pP = w1;
1804             break;
1805          case R_SPARC_HI22:
1806             w1 = *pP & 0xFFC00000;
1807             w2 = (Elf32_Word)((S + A) >> 10);
1808             ASSERT((w2 & 0xFFC00000) == 0);
1809             w1 |= w2;
1810             *pP = w1;
1811             break;
1812          case R_SPARC_LO10:
1813             w1 = *pP & ~0x3FF;
1814             w2 = (Elf32_Word)((S + A) & 0x3FF);
1815             ASSERT((w2 & ~0x3FF) == 0);
1816             w1 |= w2;
1817             *pP = w1;
1818             break;
1819          case R_SPARC_32:
1820             w2 = (Elf32_Word)(S + A);
1821             *pP = w2;
1822             break;
1823 #        endif
1824          default:
1825             fprintf(stderr, "unhandled ELF relocation(RelA) type %d\n",
1826                             ELF32_R_TYPE(info));
1827             barf("do_Elf32_Rela_relocations: unhandled ELF relocation type");
1828             return 0;
1829       }
1830
1831    }
1832    return 1;
1833 }
1834
1835
1836 static int
1837 ocResolve_ELF ( ObjectCode* oc )
1838 {
1839    char *strtab;
1840    int   shnum, ok;
1841    Elf32_Sym*  stab = NULL;
1842    char*       ehdrC = (char*)(oc->image);
1843    Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
1844    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1845
1846    /* first find "the" symbol table */
1847    stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
1848
1849    /* also go find the string table */
1850    strtab = findElfSection ( ehdrC, SHT_STRTAB );
1851
1852    if (stab == NULL || strtab == NULL) {
1853       belch("ocResolve_ELF: can't find string or symbol table");
1854       return 0;
1855    }
1856
1857    /* Process the relocation sections. */
1858    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
1859       if (shdr[shnum].sh_type == SHT_REL ) {
1860          ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
1861                                          shnum, stab, strtab );
1862          if (!ok) return ok;
1863       }
1864       else
1865       if (shdr[shnum].sh_type == SHT_RELA) {
1866          ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
1867                                           shnum, stab, strtab );
1868          if (!ok) return ok;
1869       }
1870    }
1871
1872    /* Free the local symbol table; we won't need it again. */
1873    freeHashTable(oc->lochash, NULL);
1874    oc->lochash = NULL;
1875
1876    return 1;
1877 }
1878
1879
1880 #endif /* ELF */