ghc/rts/Linker.c

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