ghc/rts/Linker.c

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