ghc/rts/Linker.c

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