ghc/rts/Linker.c

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