ghc/rts/Linker.c

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