ghc/rts/Linker.c

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