ghc/rts/Linker.c

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