ghc/rts/Linker.c

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