ghc/rts/Linker.c

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