ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.69 2001/10/19 09:45:26 sewardj 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           /* Ignore sections called which contain stabs debugging
1256              information. */
1257           && 0 != strcmp(".stab", sectab_i->Name)
1258           && 0 != strcmp(".stabstr", sectab_i->Name)
1259          ) {
1260          belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1261          return 0;
1262       }
1263
1264       if (kind != SECTIONKIND_OTHER && end >= start) {
1265          addSection(oc, kind, start, end);
1266          addProddableBlock(oc, start, end - start + 1);
1267       }
1268    }
1269
1270    /* Copy exported symbols into the ObjectCode. */
1271
1272    oc->n_symbols = hdr->NumberOfSymbols;
1273    oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
1274                                   "ocGetNames_PEi386(oc->symbols)");
1275    /* Call me paranoid; I don't care. */
1276    for (i = 0; i < oc->n_symbols; i++)
1277       oc->symbols[i] = NULL;
1278
1279    i = 0;
1280    while (1) {
1281       COFF_symbol* symtab_i;
1282       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1283       symtab_i = (COFF_symbol*)
1284                  myindex ( sizeof_COFF_symbol, symtab, i );
1285
1286       addr  = NULL;
1287
1288       if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
1289           && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1290          /* This symbol is global and defined, viz, exported */
1291          /* for MYIMAGE_SYMCLASS_EXTERNAL
1292                 && !MYIMAGE_SYM_UNDEFINED,
1293             the address of the symbol is:
1294                 address of relevant section + offset in section
1295          */
1296          COFF_section* sectabent
1297             = (COFF_section*) myindex ( sizeof_COFF_section,
1298                                         sectab,
1299                                         symtab_i->SectionNumber-1 );
1300          addr = ((UChar*)(oc->image))
1301                 + (sectabent->PointerToRawData
1302                    + symtab_i->Value);
1303       }
1304       else
1305       if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
1306           && symtab_i->Value > 0) {
1307          /* This symbol isn't in any section at all, ie, global bss.
1308             Allocate zeroed space for it. */
1309          addr = stgCallocBytes(1, symtab_i->Value,
1310                                "ocGetNames_PEi386(non-anonymous bss)");
1311          addSection(oc, SECTIONKIND_RWDATA, addr,
1312                         ((UChar*)addr) + symtab_i->Value - 1);
1313          addProddableBlock(oc, addr, symtab_i->Value);
1314          /* fprintf(stderr, "BSS      section at 0x%x\n", addr); */
1315       }
1316
1317       if (addr != NULL) {
1318          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1319          /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */
1320          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1321          ASSERT(i >= 0 && i < oc->n_symbols);
1322          /* cstring_from_COFF_symbol_name always succeeds. */
1323          oc->symbols[i] = sname;
1324          insertStrHashTable(symhash, sname, addr);
1325       } else {
1326 #        if 0
1327          fprintf ( stderr,
1328                    "IGNORING symbol %d\n"
1329                    "     name `",
1330                    i
1331                  );
1332          printName ( symtab_i->Name, strtab );
1333          fprintf ( stderr,
1334                    "'\n"
1335                    "    value 0x%x\n"
1336                    "   1+sec# %d\n"
1337                    "     type 0x%x\n"
1338                    "   sclass 0x%x\n"
1339                    "     nAux %d\n",
1340                    symtab_i->Value,
1341                    (Int32)(symtab_i->SectionNumber),
1342                    (UInt32)symtab_i->Type,
1343                    (UInt32)symtab_i->StorageClass,
1344                    (UInt32)symtab_i->NumberOfAuxSymbols
1345                  );
1346 #        endif
1347       }
1348
1349       i += symtab_i->NumberOfAuxSymbols;
1350       i++;
1351    }
1352
1353    return 1;
1354 }
1355
1356
1357 static int
1358 ocResolve_PEi386 ( ObjectCode* oc )
1359 {
1360    COFF_header*  hdr;
1361    COFF_section* sectab;
1362    COFF_symbol*  symtab;
1363    UChar*        strtab;
1364
1365    UInt32        A;
1366    UInt32        S;
1367    UInt32*       pP;
1368
1369    int i, j;
1370
1371    /* ToDo: should be variable-sized?  But is at least safe in the
1372       sense of buffer-overrun-proof. */
1373    char symbol[1000];
1374    /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1375
1376    hdr = (COFF_header*)(oc->image);
1377    sectab = (COFF_section*) (
1378                ((UChar*)(oc->image))
1379                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1380             );
1381    symtab = (COFF_symbol*) (
1382                ((UChar*)(oc->image))
1383                + hdr->PointerToSymbolTable
1384             );
1385    strtab = ((UChar*)(oc->image))
1386             + hdr->PointerToSymbolTable
1387             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1388
1389    for (i = 0; i < hdr->NumberOfSections; i++) {
1390       COFF_section* sectab_i
1391          = (COFF_section*)
1392            myindex ( sizeof_COFF_section, sectab, i );
1393       COFF_reloc* reltab
1394          = (COFF_reloc*) (
1395               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1396            );
1397
1398       /* Ignore sections called which contain stabs debugging
1399          information. */
1400       if (0 == strcmp(".stab", sectab_i->Name)
1401           || 0 == strcmp(".stabstr", sectab_i->Name))
1402          continue;
1403
1404       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1405          COFF_symbol* sym;
1406          COFF_reloc* reltab_j
1407             = (COFF_reloc*)
1408               myindex ( sizeof_COFF_reloc, reltab, j );
1409
1410          /* the location to patch */
1411          pP = (UInt32*)(
1412                  ((UChar*)(oc->image))
1413                  + (sectab_i->PointerToRawData
1414                     + reltab_j->VirtualAddress
1415                     - sectab_i->VirtualAddress )
1416               );
1417          /* the existing contents of pP */
1418          A = *pP;
1419          /* the symbol to connect to */
1420          sym = (COFF_symbol*)
1421                myindex ( sizeof_COFF_symbol,
1422                          symtab, reltab_j->SymbolTableIndex );
1423          IF_DEBUG(linker,
1424                   fprintf ( stderr,
1425                             "reloc sec %2d num %3d:  type 0x%-4x   "
1426                             "vaddr 0x%-8x   name `",
1427                             i, j,
1428                             (UInt32)reltab_j->Type,
1429                             reltab_j->VirtualAddress );
1430                             printName ( sym->Name, strtab );
1431                             fprintf ( stderr, "'\n" ));
1432
1433          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1434             COFF_section* section_sym
1435                = findPEi386SectionCalled ( oc, sym->Name );
1436             if (!section_sym) {
1437                belch("%s: can't find section `%s'", oc->fileName, sym->Name);
1438                return 0;
1439             }
1440             S = ((UInt32)(oc->image))
1441                 + (section_sym->PointerToRawData
1442                    + sym->Value);
1443          } else {
1444             copyName ( sym->Name, strtab, symbol, 1000-1 );
1445             (void*)S = lookupLocalSymbol( oc, symbol );
1446             if ((void*)S != NULL) goto foundit;
1447             (void*)S = lookupSymbol( symbol );
1448             if ((void*)S != NULL) goto foundit;
1449             zapTrailingAtSign ( symbol );
1450             (void*)S = lookupLocalSymbol( oc, symbol );
1451             if ((void*)S != NULL) goto foundit;
1452             (void*)S = lookupSymbol( symbol );
1453             if ((void*)S != NULL) goto foundit;
1454             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1455             return 0;
1456            foundit:
1457          }
1458          checkProddableBlock(oc, pP);
1459          switch (reltab_j->Type) {
1460             case MYIMAGE_REL_I386_DIR32:
1461                *pP = A + S;
1462                break;
1463             case MYIMAGE_REL_I386_REL32:
1464                /* Tricky.  We have to insert a displacement at
1465                   pP which, when added to the PC for the _next_
1466                   insn, gives the address of the target (S).
1467                   Problem is to know the address of the next insn
1468                   when we only know pP.  We assume that this
1469                   literal field is always the last in the insn,
1470                   so that the address of the next insn is pP+4
1471                   -- hence the constant 4.
1472                   Also I don't know if A should be added, but so
1473                   far it has always been zero.
1474                */
1475                ASSERT(A==0);
1476                *pP = S - ((UInt32)pP) - 4;
1477                break;
1478             default:
1479                belch("%s: unhandled PEi386 relocation type %d",
1480                      oc->fileName, reltab_j->Type);
1481                return 0;
1482          }
1483
1484       }
1485    }
1486
1487    IF_DEBUG(linker, belch("completed %s", oc->fileName));
1488    return 1;
1489 }
1490
1491 #endif /* defined(OBJFORMAT_PEi386) */
1492
1493
1494 /* --------------------------------------------------------------------------
1495  * ELF specifics
1496  * ------------------------------------------------------------------------*/
1497
1498 #if defined(OBJFORMAT_ELF)
1499
1500 #define FALSE 0
1501 #define TRUE  1
1502
1503 #if defined(sparc_TARGET_ARCH)
1504 #  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
1505 #elif defined(i386_TARGET_ARCH)
1506 #  define ELF_TARGET_386    /* Used inside <elf.h> */
1507 #endif
1508 /* There is a similar case for IA64 in the Solaris2 headers if this
1509  * ever becomes relevant.
1510  */
1511
1512 #include <elf.h>
1513
1514 static char *
1515 findElfSection ( void* objImage, Elf32_Word sh_type )
1516 {
1517    int i;
1518    char* ehdrC = (char*)objImage;
1519    Elf32_Ehdr* ehdr = (Elf32_Ehdr*)ehdrC;
1520    Elf32_Shdr* shdr = (Elf32_Shdr*)(ehdrC + ehdr->e_shoff);
1521    char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1522    char* ptr = NULL;
1523    for (i = 0; i < ehdr->e_shnum; i++) {
1524       if (shdr[i].sh_type == sh_type
1525           /* Ignore the section header's string table. */
1526           && i != ehdr->e_shstrndx
1527           /* Ignore string tables named .stabstr, as they contain
1528              debugging info. */
1529           && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
1530          ) {
1531          ptr = ehdrC + shdr[i].sh_offset;
1532          break;
1533       }
1534    }
1535    return ptr;
1536 }
1537
1538
1539 static int
1540 ocVerifyImage_ELF ( ObjectCode* oc )
1541 {
1542    Elf32_Shdr* shdr;
1543    Elf32_Sym*  stab;
1544    int i, j, nent, nstrtab, nsymtabs;
1545    char* sh_strtab;
1546    char* strtab;
1547
1548    char*       ehdrC = (char*)(oc->image);
1549    Elf32_Ehdr* ehdr  = ( Elf32_Ehdr*)ehdrC;
1550
1551    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1552        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1553        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1554        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1555       belch("%s: not an ELF header", oc->fileName);
1556       return 0;
1557    }
1558    IF_DEBUG(linker,belch( "Is an ELF header" ));
1559
1560    if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1561       belch("%s: not 32 bit ELF", oc->fileName);
1562       return 0;
1563    }
1564
1565    IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1566
1567    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1568        IF_DEBUG(linker,belch( "Is little-endian" ));
1569    } else
1570    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1571        IF_DEBUG(linker,belch( "Is big-endian" ));
1572    } else {
1573        belch("%s: unknown endiannness", oc->fileName);
1574        return 0;
1575    }
1576
1577    if (ehdr->e_type != ET_REL) {
1578       belch("%s: not a relocatable object (.o) file", oc->fileName);
1579       return 0;
1580    }
1581    IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1582
1583    IF_DEBUG(linker,belch( "Architecture is " ));
1584    switch (ehdr->e_machine) {
1585       case EM_386:   IF_DEBUG(linker,belch( "x86" )); break;
1586       case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1587       default:       IF_DEBUG(linker,belch( "unknown" ));
1588                      belch("%s: unknown architecture", oc->fileName);
1589                      return 0;
1590    }
1591
1592    IF_DEBUG(linker,belch(
1593              "\nSection header table: start %d, n_entries %d, ent_size %d",
1594              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
1595
1596    ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1597
1598    shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1599
1600    if (ehdr->e_shstrndx == SHN_UNDEF) {
1601       belch("%s: no section header string table", oc->fileName);
1602       return 0;
1603    } else {
1604       IF_DEBUG(linker,belch( "Section header string table is section %d",
1605                           ehdr->e_shstrndx));
1606       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1607    }
1608
1609    for (i = 0; i < ehdr->e_shnum; i++) {
1610       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
1611       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", (int)shdr[i].sh_type ));
1612       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", (int)shdr[i].sh_size ));
1613       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", (int)shdr[i].sh_offset ));
1614       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
1615                ehdrC + shdr[i].sh_offset,
1616                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1617
1618       if (shdr[i].sh_type == SHT_REL) {
1619           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
1620       } else if (shdr[i].sh_type == SHT_RELA) {
1621           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1622       } else {
1623           IF_DEBUG(linker,fprintf(stderr,"     "));
1624       }
1625       if (sh_strtab) {
1626           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1627       }
1628    }
1629
1630    IF_DEBUG(linker,belch( "\nString tables" ));
1631    strtab = NULL;
1632    nstrtab = 0;
1633    for (i = 0; i < ehdr->e_shnum; i++) {
1634       if (shdr[i].sh_type == SHT_STRTAB
1635           /* Ignore the section header's string table. */
1636           && i != ehdr->e_shstrndx
1637           /* Ignore string tables named .stabstr, as they contain
1638              debugging info. */
1639           && 0 != strcmp(".stabstr", sh_strtab + shdr[i].sh_name)
1640          ) {
1641          IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
1642          strtab = ehdrC + shdr[i].sh_offset;
1643          nstrtab++;
1644       }
1645    }
1646    if (nstrtab != 1) {
1647       belch("%s: no string tables, or too many", oc->fileName);
1648       return 0;
1649    }
1650
1651    nsymtabs = 0;
1652    IF_DEBUG(linker,belch( "\nSymbol tables" ));
1653    for (i = 0; i < ehdr->e_shnum; i++) {
1654       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1655       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1656       nsymtabs++;
1657       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1658       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1659       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
1660                nent,
1661                shdr[i].sh_size % sizeof(Elf32_Sym)
1662              ));
1663       if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1664          belch("%s: non-integral number of symbol table entries", oc->fileName);
1665          return 0;
1666       }
1667       for (j = 0; j < nent; j++) {
1668          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
1669          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ",
1670                              (int)stab[j].st_shndx,
1671                              (int)stab[j].st_size,
1672                              (char*)stab[j].st_value ));
1673
1674          IF_DEBUG(linker,fprintf(stderr, "type=" ));
1675          switch (ELF32_ST_TYPE(stab[j].st_info)) {
1676             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1677             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1678             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
1679             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1680             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
1681             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
1682          }
1683          IF_DEBUG(linker,fprintf(stderr, "  " ));
1684
1685          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1686          switch (ELF32_ST_BIND(stab[j].st_info)) {
1687             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1688             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1689             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
1690             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
1691          }
1692          IF_DEBUG(linker,fprintf(stderr, "  " ));
1693
1694          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1695       }
1696    }
1697
1698    if (nsymtabs == 0) {
1699       belch("%s: didn't find any symbol tables", oc->fileName);
1700       return 0;
1701    }
1702
1703    return 1;
1704 }
1705
1706
1707 static int
1708 ocGetNames_ELF ( ObjectCode* oc )
1709 {
1710    int i, j, k, nent;
1711    Elf32_Sym* stab;
1712
1713    char*       ehdrC      = (char*)(oc->image);
1714    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
1715    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
1716    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1717    char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1718
1719    ASSERT(symhash != NULL);
1720
1721    if (!strtab) {
1722       belch("%s: no strtab", oc->fileName);
1723       return 0;
1724    }
1725
1726    k = 0;
1727    for (i = 0; i < ehdr->e_shnum; i++) {
1728
1729       /* make a section entry for relevant sections */
1730       SectionKind kind = SECTIONKIND_OTHER;
1731       if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
1732           !strcmp(".data1",sh_strtab+shdr[i].sh_name) ||
1733           !strcmp(".bss",sh_strtab+shdr[i].sh_name))
1734           kind = SECTIONKIND_RWDATA;
1735       if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
1736           !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
1737           !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
1738           kind = SECTIONKIND_CODE_OR_RODATA;
1739
1740       if (!strcmp(".bss",sh_strtab+shdr[i].sh_name) && shdr[i].sh_size > 0) {
1741          /* This is a non-empty .bss section.  Allocate zeroed space for
1742             it, and set its .sh_offset field such that
1743             ehdrC + .sh_offset == addr_of_zeroed_space.  */
1744          char* zspace = stgCallocBytes(1, shdr[i].sh_size,
1745                                        "ocGetNames_ELF(BSS)");
1746          shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
1747          /*
1748          fprintf(stderr, "BSS section at 0x%x, size %d\n",
1749                          zspace, shdr[i].sh_size);
1750          */
1751       }
1752
1753       /* fill in the section info */
1754       addSection(oc, kind, ehdrC + shdr[i].sh_offset,
1755                      ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
1756       if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0)
1757          addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
1758
1759       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1760
1761       /* copy stuff into this module's object symbol table */
1762       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1763       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1764
1765       oc->n_symbols = nent;
1766       oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
1767                                    "ocGetNames_ELF(oc->symbols)");
1768
1769       for (j = 0; j < nent; j++) {
1770
1771          char  isLocal = FALSE; /* avoids uninit-var warning */
1772          char* ad      = NULL;
1773          char* nm      = strtab + stab[j].st_name;
1774          int   secno   = stab[j].st_shndx;
1775
1776          /* Figure out if we want to add it; if so, set ad to its
1777             address.  Otherwise leave ad == NULL. */
1778
1779          if (secno == SHN_COMMON) {
1780             isLocal = FALSE;
1781             ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
1782             /*
1783             fprintf(stderr, "COMMON symbol, size %d name %s\n",
1784                             stab[j].st_size, nm);
1785             */
1786             /* Pointless to do addProddableBlock() for this area,
1787                since the linker should never poke around in it. */
1788          }
1789          else
1790          if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1791                 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1792               )
1793               /* and not an undefined symbol */
1794               && stab[j].st_shndx != SHN_UNDEF
1795               /* and not in a "special section" */
1796               && stab[j].st_shndx < SHN_LORESERVE
1797               &&
1798               /* and it's a not a section or string table or anything silly */
1799               ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1800                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1801                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE
1802               )
1803             ) {
1804             /* Section 0 is the undefined section, hence > and not >=. */
1805             ASSERT(secno > 0 && secno < ehdr->e_shnum);
1806             /*
1807             if (shdr[secno].sh_type == SHT_NOBITS) {
1808                fprintf(stderr, "   BSS symbol, size %d off %d name %s\n",
1809                                stab[j].st_size, stab[j].st_value, nm);
1810             }
1811             */
1812             ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
1813             if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
1814                IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p  %s %s",
1815                                       ad, oc->fileName, nm ));
1816                isLocal = TRUE;
1817             } else {
1818                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
1819                                       ad, oc->fileName, nm ));
1820                isLocal = FALSE;
1821             }
1822          }
1823
1824          /* And the decision is ... */
1825
1826          if (ad != NULL) {
1827             ASSERT(nm != NULL);
1828             oc->symbols[j] = nm;
1829             /* Acquire! */
1830             if (isLocal) {
1831                insertStrHashTable(oc->lochash, nm, ad);
1832             } else {
1833                insertStrHashTable(symhash, nm, ad);
1834             }
1835          } else {
1836             /* Skip. */
1837             IF_DEBUG(linker,belch( "skipping `%s'",
1838                                    strtab + stab[j].st_name ));
1839             /*
1840             fprintf(stderr,
1841                     "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
1842                     (int)ELF32_ST_BIND(stab[j].st_info),
1843                     (int)ELF32_ST_TYPE(stab[j].st_info),
1844                     (int)stab[j].st_shndx,
1845                     strtab + stab[j].st_name
1846                    );
1847             */
1848             oc->symbols[j] = NULL;
1849          }
1850
1851       }
1852    }
1853
1854    return 1;
1855 }
1856
1857
1858 /* Do ELF relocations which lack an explicit addend.  All x86-linux
1859    relocations appear to be of this form. */
1860 static int
1861 do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
1862                            Elf32_Shdr* shdr, int shnum,
1863                            Elf32_Sym*  stab, char* strtab )
1864 {
1865    int j;
1866    char *symbol;
1867    Elf32_Word* targ;
1868    Elf32_Rel*  rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset);
1869    int         nent = shdr[shnum].sh_size / sizeof(Elf32_Rel);
1870    int target_shndx = shdr[shnum].sh_info;
1871    int symtab_shndx = shdr[shnum].sh_link;
1872    stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1873    targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1874    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1875                           target_shndx, symtab_shndx ));
1876    for (j = 0; j < nent; j++) {
1877       Elf32_Addr offset = rtab[j].r_offset;
1878       Elf32_Word info   = rtab[j].r_info;
1879
1880       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
1881       Elf32_Word* pP = (Elf32_Word*)P;
1882       Elf32_Addr  A  = *pP;
1883       Elf32_Addr  S;
1884
1885       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
1886                              j, (void*)offset, (void*)info ));
1887       if (!info) {
1888          IF_DEBUG(linker,belch( " ZERO" ));
1889          S = 0;
1890       } else {
1891          /* First see if it is a nameless local symbol. */
1892          if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1893             symbol = "(noname)";
1894             S = (Elf32_Addr)
1895                 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1896                        + stab[ELF32_R_SYM(info)].st_value);
1897          } else {
1898             /* No?  Should be in a symbol table then; first try the
1899                local one. */
1900             symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1901             (void*)S = lookupLocalSymbol( oc, symbol );
1902             if ((void*)S == NULL)
1903                (void*)S = lookupSymbol( symbol );
1904          }
1905          if (!S) {
1906             belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1907             return 0;
1908          }
1909          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1910       }
1911       IF_DEBUG(linker,belch( "Reloc: P = %p   S = %p   A = %p",
1912                              (void*)P, (void*)S, (void*)A ));
1913       checkProddableBlock ( oc, pP );
1914       switch (ELF32_R_TYPE(info)) {
1915 #        ifdef i386_TARGET_ARCH
1916          case R_386_32:   *pP = S + A;     break;
1917          case R_386_PC32: *pP = S + A - P; break;
1918 #        endif
1919          default:
1920             belch("%s: unhandled ELF relocation(Rel) type %d\n",
1921                   oc->fileName, ELF32_R_TYPE(info));
1922             return 0;
1923       }
1924
1925    }
1926    return 1;
1927 }
1928
1929
1930 /* Do ELF relocations for which explicit addends are supplied.
1931    sparc-solaris relocations appear to be of this form. */
1932 static int
1933 do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
1934                             Elf32_Shdr* shdr, int shnum,
1935                             Elf32_Sym*  stab, char* strtab )
1936 {
1937    int j;
1938    char *symbol;
1939    Elf32_Word* targ;
1940    Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset);
1941    int         nent = shdr[shnum].sh_size / sizeof(Elf32_Rela);
1942    int target_shndx = shdr[shnum].sh_info;
1943    int symtab_shndx = shdr[shnum].sh_link;
1944    stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1945    targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1946    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1947                           target_shndx, symtab_shndx ));
1948    for (j = 0; j < nent; j++) {
1949       Elf32_Addr  offset = rtab[j].r_offset;
1950       Elf32_Word  info   = rtab[j].r_info;
1951       Elf32_Sword addend = rtab[j].r_addend;
1952       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
1953       Elf32_Addr  A  = addend;
1954       Elf32_Addr  S;
1955 #     if defined(sparc_TARGET_ARCH)
1956       /* This #ifdef only serves to avoid unused-var warnings. */
1957       Elf32_Word* pP = (Elf32_Word*)P;
1958       Elf32_Word  w1, w2;
1959 #     endif
1960
1961       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p)   ",
1962                              j, (void*)offset, (void*)info,
1963                                 (void*)addend ));
1964       if (!info) {
1965          IF_DEBUG(linker,belch( " ZERO" ));
1966          S = 0;
1967       } else {
1968          /* First see if it is a nameless local symbol. */
1969          if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1970             symbol = "(noname)";
1971             S = (Elf32_Addr)
1972                 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1973                        + stab[ELF32_R_SYM(info)].st_value);
1974          } else {
1975             /* No?  Should be in a symbol table then; first try the
1976                local one. */
1977             symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1978             (void*)S = lookupLocalSymbol( oc, symbol );
1979             if ((void*)S == NULL)
1980                (void*)S = lookupSymbol( symbol );
1981          }
1982          if (!S) {
1983            belch("%s: unknown symbol `%s'", oc->fileName, symbol);
1984            return 0;
1985            /*
1986            S = 0x11223344;
1987            fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
1988            */
1989          }
1990          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1991       }
1992       IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n",
1993                                         (void*)P, (void*)S, (void*)A ));
1994       checkProddableBlock ( oc, (void*)P );
1995       switch (ELF32_R_TYPE(info)) {
1996 #        if defined(sparc_TARGET_ARCH)
1997          case R_SPARC_WDISP30:
1998             w1 = *pP & 0xC0000000;
1999             w2 = (Elf32_Word)((S + A - P) >> 2);
2000             ASSERT((w2 & 0xC0000000) == 0);
2001             w1 |= w2;
2002             *pP = w1;
2003             break;
2004          case R_SPARC_HI22:
2005             w1 = *pP & 0xFFC00000;
2006             w2 = (Elf32_Word)((S + A) >> 10);
2007             ASSERT((w2 & 0xFFC00000) == 0);
2008             w1 |= w2;
2009             *pP = w1;
2010             break;
2011          case R_SPARC_LO10:
2012             w1 = *pP & ~0x3FF;
2013             w2 = (Elf32_Word)((S + A) & 0x3FF);
2014             ASSERT((w2 & ~0x3FF) == 0);
2015             w1 |= w2;
2016             *pP = w1;
2017             break;
2018          /* According to the Sun documentation:
2019             R_SPARC_UA32
2020             This relocation type resembles R_SPARC_32, except it refers to an
2021             unaligned word. That is, the word to be relocated must be treated
2022             as four separate bytes with arbitrary alignment, not as a word
2023             aligned according to the architecture requirements.
2024
2025             (JRS: which means that freeloading on the R_SPARC_32 case
2026             is probably wrong, but hey ...)
2027          */
2028          case R_SPARC_UA32:
2029          case R_SPARC_32:
2030             w2 = (Elf32_Word)(S + A);
2031             *pP = w2;
2032             break;
2033 #        endif
2034          default:
2035             belch("%s: unhandled ELF relocation(RelA) type %d\n",
2036                   oc->fileName, ELF32_R_TYPE(info));
2037             return 0;
2038       }
2039
2040    }
2041    return 1;
2042 }
2043
2044
2045 static int
2046 ocResolve_ELF ( ObjectCode* oc )
2047 {
2048    char *strtab;
2049    int   shnum, ok;
2050    Elf32_Sym*  stab = NULL;
2051    char*       ehdrC = (char*)(oc->image);
2052    Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
2053    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
2054    char* sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2055
2056    /* first find "the" symbol table */
2057    stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
2058
2059    /* also go find the string table */
2060    strtab = findElfSection ( ehdrC, SHT_STRTAB );
2061
2062    if (stab == NULL || strtab == NULL) {
2063       belch("%s: can't find string or symbol table", oc->fileName);
2064       return 0;
2065    }
2066
2067    /* Process the relocation sections. */
2068    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
2069
2070       /* Skip sections called ".rel.stab".  These appear to contain
2071          relocation entries that, when done, make the stabs debugging
2072          info point at the right places.  We ain't interested in all
2073          dat jazz, mun. */
2074       if (0 == strcmp(".rel.stab", sh_strtab + shdr[shnum].sh_name))
2075          continue;
2076
2077       if (shdr[shnum].sh_type == SHT_REL ) {
2078          ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr,
2079                                          shnum, stab, strtab );
2080          if (!ok) return ok;
2081       }
2082       else
2083       if (shdr[shnum].sh_type == SHT_RELA) {
2084          ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr,
2085                                           shnum, stab, strtab );
2086          if (!ok) return ok;
2087       }
2088
2089    }
2090
2091    /* Free the local symbol table; we won't need it again. */
2092    freeHashTable(oc->lochash, NULL);
2093    oc->lochash = NULL;
2094
2095    return 1;
2096 }
2097
2098
2099 #endif /* ELF */