ghc/rts/Linker.c

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