ghc/rts/Linker.c

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