ghc/rts/Linker.c

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