ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.16 2001/02/01 12:37:44 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                     if (s->lbl != NULL) {
 478                         removeStrHashTable(symhash, s->lbl, NULL);
 479                     }
 480                 }
 481             }
 482
 483             /* We're going to leave this in place, in case there are
 484                any pointers from the heap into it: */
 485             /* free(oc->image); */
 486             free(oc->symbols);
 487             free(oc->sections);
 488             free(oc);
 489             return 1;
 490         }
 491     }
 492
 493     belch("unloadObj: can't find `%s' to unload", path);
 494     return 0;
 495 }
 496
 497 /* --------------------------------------------------------------------------
 498  * PEi386 specifics (Win32 targets)
 499  * ------------------------------------------------------------------------*/
 500
 501 /* The information for this linker comes from
 502       Microsoft Portable Executable
 503       and Common Object File Format Specification
 504       revision 5.1 January 1998
 505    which SimonM says comes from the MS Developer Network CDs.
 506 */
 507
 508
 509 #if defined(OBJFORMAT_PEi386)
 510
 511
 512
 513 typedef unsigned char  UChar;
 514 typedef unsigned short UInt16;
 515 typedef unsigned int   UInt32;
 516 typedef          int   Int32;
 517
 518
 519 typedef
 520    struct {
 521       UInt16 Machine;
 522       UInt16 NumberOfSections;
 523       UInt32 TimeDateStamp;
 524       UInt32 PointerToSymbolTable;
 525       UInt32 NumberOfSymbols;
 526       UInt16 SizeOfOptionalHeader;
 527       UInt16 Characteristics;
 528    }
 529    COFF_header;
 530
 531 #define sizeof_COFF_header 20
 532
 533
 534 typedef
 535    struct {
 536       UChar  Name[8];
 537       UInt32 VirtualSize;
 538       UInt32 VirtualAddress;
 539       UInt32 SizeOfRawData;
 540       UInt32 PointerToRawData;
 541       UInt32 PointerToRelocations;
 542       UInt32 PointerToLinenumbers;
 543       UInt16 NumberOfRelocations;
 544       UInt16 NumberOfLineNumbers;
 545       UInt32 Characteristics;
 546    }
 547    COFF_section;
 548
 549 #define sizeof_COFF_section 40
 550
 551
 552 typedef
 553    struct {
 554       UChar  Name[8];
 555       UInt32 Value;
 556       UInt16 SectionNumber;
 557       UInt16 Type;
 558       UChar  StorageClass;
 559       UChar  NumberOfAuxSymbols;
 560    }
 561    COFF_symbol;
 562
 563 #define sizeof_COFF_symbol 18
 564
 565
 566 typedef
 567    struct {
 568       UInt32 VirtualAddress;
 569       UInt32 SymbolTableIndex;
 570       UInt16 Type;
 571    }
 572    COFF_reloc;
 573
 574 #define sizeof_COFF_reloc 10
 575
 576
 577 /* From PE spec doc, section 3.3.2 */
 578 #define IMAGE_FILE_RELOCS_STRIPPED     0x0001
 579 #define IMAGE_FILE_EXECUTABLE_IMAGE    0x0002
 580 #define IMAGE_FILE_DLL                 0x2000
 581 #define IMAGE_FILE_SYSTEM              0x1000
 582 #define IMAGE_FILE_BYTES_REVERSED_HI   0x8000
 583 #define IMAGE_FILE_BYTES_REVERSED_LO   0x0080
 584 #define IMAGE_FILE_32BIT_MACHINE       0x0100
 585
 586 /* From PE spec doc, section 5.4.2 and 5.4.4 */
 587 #define IMAGE_SYM_CLASS_EXTERNAL       2
 588 #define IMAGE_SYM_CLASS_STATIC         3
 589 #define IMAGE_SYM_UNDEFINED            0
 590
 591 /* From PE spec doc, section 4.1 */
 592 #define IMAGE_SCN_CNT_CODE             0x00000020
 593 #define IMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
 594
 595 /* From PE spec doc, section 5.2.1 */
 596 #define IMAGE_REL_I386_DIR32           0x0006
 597 #define IMAGE_REL_I386_REL32           0x0014
 598
 599
 600 /* We use myindex to calculate array addresses, rather than
 601    simply doing the normal subscript thing.  That's because
 602    some of the above structs have sizes which are not
 603    a whole number of words.  GCC rounds their sizes up to a
 604    whole number of words, which means that the address calcs
 605    arising from using normal C indexing or pointer arithmetic
 606    are just plain wrong.  Sigh.
 607 */
 608 static UChar *
 609 myindex ( int scale, int index, void* base )
 610 {
 611    return
 612       ((UChar*)base) + scale * index;
 613 }
 614
 615
 616 static void
 617 printName ( UChar* name, UChar* strtab )
 618 {
 619    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 620       UInt32 strtab_offset = * (UInt32*)(name+4);
 621       fprintf ( stderr, "%s", strtab + strtab_offset );
 622    } else {
 623       int i;
 624       for (i = 0; i < 8; i++) {
 625          if (name[i] == 0) break;
 626          fprintf ( stderr, "%c", name[i] );
 627       }
 628    }
 629 }
 630
 631
 632 static void
 633 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
 634 {
 635    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 636       UInt32 strtab_offset = * (UInt32*)(name+4);
 637       strncpy ( dst, strtab+strtab_offset, dstSize );
 638       dst[dstSize-1] = 0;
 639    } else {
 640       int i = 0;
 641       while (1) {
 642          if (i >= 8) break;
 643          if (name[i] == 0) break;
 644          dst[i] = name[i];
 645          i++;
 646       }
 647       dst[i] = 0;
 648    }
 649 }
 650
 651
 652 static UChar *
 653 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
 654 {
 655    UChar* newstr;
 656    /* If the string is longer than 8 bytes, look in the
 657       string table for it -- this will be correctly zero terminated.
 658    */
 659    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 660       UInt32 strtab_offset = * (UInt32*)(name+4);
 661       return ((UChar*)strtab) + strtab_offset;
 662    }
 663    /* Otherwise, if shorter than 8 bytes, return the original,
 664       which by defn is correctly terminated.
 665    */
 666    if (name[7]==0) return name;
 667    /* The annoying case: 8 bytes.  Copy into a temporary
 668       (which is never freed ...)
 669    */
 670    newstr = malloc(9);
 671    if (newstr) {
 672       strncpy(newstr,name,8);
 673       newstr[8] = 0;
 674    }
 675    return newstr;
 676 }
 677
 678
 679 /* Just compares the short names (first 8 chars) */
 680 static COFF_section *
 681 findPEi386SectionCalled ( ObjectCode* oc,  char* name )
 682 {
 683    int i;
 684    COFF_header* hdr
 685       = (COFF_header*)(oc->image);
 686    COFF_section* sectab
 687       = (COFF_section*) (
 688            ((UChar*)(oc->image))
 689            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 690         );
 691    for (i = 0; i < hdr->NumberOfSections; i++) {
 692       UChar* n1;
 693       UChar* n2;
 694       COFF_section* section_i
 695          = (COFF_section*)
 696            myindex ( sizeof_COFF_section, i, sectab );
 697       n1 = (UChar*) &(section_i->Name);
 698       n2 = name;
 699       if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
 700           n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
 701           n1[6]==n2[6] && n1[7]==n2[7])
 702          return section_i;
 703    }
 704
 705    return NULL;
 706 }
 707
 708
 709 static void
 710 zapTrailingAtSign ( UChar* sym )
 711 {
 712    int i, j;
 713    if (sym[0] == 0) return;
 714    i = 0;
 715    while (sym[i] != 0) i++;
 716    i--;
 717    j = i;
 718    while (j > 0 && isdigit(sym[j])) j--;
 719    if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
 720 }
 721
 722
 723 static int
 724 ocVerifyImage_PEi386 ( ObjectCode* oc )
 725 {
 726    int i, j;
 727    COFF_header*  hdr;
 728    COFF_section* sectab;
 729    COFF_symbol*  symtab;
 730    UChar*        strtab;
 731
 732    hdr = (COFF_header*)(oc->image);
 733    sectab = (COFF_section*) (
 734                ((UChar*)(oc->image))
 735                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 736             );
 737    symtab = (COFF_symbol*) (
 738                ((UChar*)(oc->image))
 739                + hdr->PointerToSymbolTable
 740             );
 741    strtab = ((UChar*)(oc->image))
 742             + hdr->PointerToSymbolTable
 743             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 744
 745    if (hdr->Machine != 0x14c) {
 746       oc->errMsg("Not x86 PEi386");
 747       return FALSE;
 748    }
 749    if (hdr->SizeOfOptionalHeader != 0) {
 750       oc->errMsg("PEi386 with nonempty optional header");
 751       return FALSE;
 752    }
 753    if ( /* (hdr->Characteristics & IMAGE_FILE_RELOCS_STRIPPED) || */
 754         (hdr->Characteristics & IMAGE_FILE_EXECUTABLE_IMAGE) ||
 755         (hdr->Characteristics & IMAGE_FILE_DLL) ||
 756         (hdr->Characteristics & IMAGE_FILE_SYSTEM) ) {
 757       oc->errMsg("Not a PEi386 object file");
 758       return FALSE;
 759    }
 760    if ( (hdr->Characteristics & IMAGE_FILE_BYTES_REVERSED_HI) ||
 761         !(hdr->Characteristics & IMAGE_FILE_32BIT_MACHINE) ) {
 762       oc->errMsg("Invalid PEi386 word size or endiannness");
 763       return FALSE;
 764    }
 765
 766    if (!verb) return TRUE;
 767    /* No further verification after this point; only debug printing. */
 768
 769    fprintf ( stderr,
 770              "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
 771    fprintf ( stderr,
 772              "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
 773    fprintf ( stderr,
 774              "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
 775
 776    fprintf ( stderr, "\n" );
 777    fprintf ( stderr,
 778              "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
 779    fprintf ( stderr,
 780              "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
 781    fprintf ( stderr,
 782              "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
 783    fprintf ( stderr,
 784              "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
 785    fprintf ( stderr,
 786              "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
 787    fprintf ( stderr,
 788              "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
 789    fprintf ( stderr,
 790              "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
 791
 792    fprintf ( stderr, "\n" );
 793    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
 794    fprintf ( stderr, "---START of string table---\n");
 795    for (i = 4; i < *(UInt32*)strtab; i++) {
 796       if (strtab[i] == 0)
 797          fprintf ( stderr, "\n"); else
 798          fprintf( stderr, "%c", strtab[i] );
 799    }
 800    fprintf ( stderr, "--- END  of string table---\n");
 801
 802    fprintf ( stderr, "\n" );
 803    for (i = 0; i < hdr->NumberOfSections; i++) {
 804       COFF_reloc* reltab;
 805       COFF_section* sectab_i
 806          = (COFF_section*)
 807            myindex ( sizeof_COFF_section, i, sectab );
 808       fprintf ( stderr,
 809                 "\n"
 810                 "section %d\n"
 811                 "     name `",
 812                 i
 813               );
 814       printName ( sectab_i->Name, strtab );
 815       fprintf ( stderr,
 816                 "'\n"
 817                 "    vsize %d\n"
 818                 "    vaddr %d\n"
 819                 "  data sz %d\n"
 820                 " data off %d\n"
 821                 "  num rel %d\n"
 822                 "  off rel %d\n",
 823                 sectab_i->VirtualSize,
 824                 sectab_i->VirtualAddress,
 825                 sectab_i->SizeOfRawData,
 826                 sectab_i->PointerToRawData,
 827                 sectab_i->NumberOfRelocations,
 828                 sectab_i->PointerToRelocations
 829               );
 830       reltab = (COFF_reloc*) (
 831                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
 832                );
 833       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
 834          COFF_symbol* sym;
 835          COFF_reloc* rel = (COFF_reloc*)
 836                            myindex ( sizeof_COFF_reloc, j, reltab );
 837          fprintf ( stderr,
 838                    "        type 0x%-4x   vaddr 0x%-8x   name `",
 839                    (UInt32)rel->Type,
 840                    rel->VirtualAddress );
 841          sym = (COFF_symbol*)
 842                myindex ( sizeof_COFF_symbol, rel->SymbolTableIndex, symtab );
 843          printName ( sym->Name, strtab );
 844          fprintf ( stderr, "'\n" );
 845       }
 846       fprintf ( stderr, "\n" );
 847    }
 848
 849
 850    fprintf ( stderr, "\n" );
 851    i = 0;
 852    while (1) {
 853       COFF_symbol* symtab_i;
 854       if (i >= hdr->NumberOfSymbols) break;
 855       symtab_i = (COFF_symbol*)
 856                  myindex ( sizeof_COFF_symbol, i, symtab );
 857       fprintf ( stderr,
 858                 "symbol %d\n"
 859                 "     name `",
 860                 i
 861               );
 862       printName ( symtab_i->Name, strtab );
 863       fprintf ( stderr,
 864                 "'\n"
 865                 "    value 0x%x\n"
 866                 "     sec# %d\n"
 867                 "     type 0x%x\n"
 868                 "   sclass 0x%x\n"
 869                 "     nAux %d\n",
 870                 symtab_i->Value,
 871                 (Int32)(symtab_i->SectionNumber) - 1,
 872                 (UInt32)symtab_i->Type,
 873                 (UInt32)symtab_i->StorageClass,
 874                 (UInt32)symtab_i->NumberOfAuxSymbols
 875               );
 876       i += symtab_i->NumberOfAuxSymbols;
 877       i++;
 878    }
 879
 880    fprintf ( stderr, "\n" );
 881
 882    return TRUE;
 883 }
 884
 885
 886 static int
 887 ocGetNames_PEi386 ( ObjectCode* oc )
 888 {
 889    COFF_header*  hdr;
 890    COFF_section* sectab;
 891    COFF_symbol*  symtab;
 892    UChar*        strtab;
 893
 894    UChar* sname;
 895    void*  addr;
 896    int    i;
 897
 898    hdr = (COFF_header*)(oc->image);
 899    sectab = (COFF_section*) (
 900                ((UChar*)(oc->image))
 901                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 902             );
 903    symtab = (COFF_symbol*) (
 904                ((UChar*)(oc->image))
 905                + hdr->PointerToSymbolTable
 906             );
 907    strtab = ((UChar*)(oc->image))
 908             + hdr->PointerToSymbolTable
 909             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 910
 911    /* Copy exported symbols into the ObjectCode. */
 912    i = 0;
 913    while (1) {
 914       COFF_symbol* symtab_i;
 915       if (i >= hdr->NumberOfSymbols) break;
 916       symtab_i = (COFF_symbol*)
 917                  myindex ( sizeof_COFF_symbol, i, symtab );
 918
 919       if (symtab_i->StorageClass == IMAGE_SYM_CLASS_EXTERNAL &&
 920           symtab_i->SectionNumber != IMAGE_SYM_UNDEFINED) {
 921
 922          /* This symbol is global and defined, viz, exported */
 923          COFF_section* sectabent;
 924
 925          sname = cstring_from_COFF_symbol_name (
 926                     symtab_i->Name, strtab
 927                  );
 928          if (!sname) {
 929             oc->errMsg("Out of memory when copying PEi386 symbol");
 930             return FALSE;
 931          }
 932
 933          /* for IMAGE_SYMCLASS_EXTERNAL
 934                 && !IMAGE_SYM_UNDEFINED,
 935             the address of the symbol is:
 936                 address of relevant section + offset in section
 937          */
 938          sectabent = (COFF_section*)
 939                      myindex ( sizeof_COFF_section,
 940                                symtab_i->SectionNumber-1,
 941                                sectab );
 942          addr = ((UChar*)(oc->image))
 943                 + (sectabent->PointerToRawData
 944                    + symtab_i->Value);
 945          /* fprintf ( stderr, "addSymbol %p `%s'\n", addr,sname); */
 946          if (!addSymbol(oc,sname,addr)) return FALSE;
 947       }
 948       i += symtab_i->NumberOfAuxSymbols;
 949       i++;
 950    }
 951
 952    oc->sections = stgMallocBytes( NumberOfSections * sizeof(Section),
 953                                     "ocGetNamesPEi386" );
 954
 955    /* Copy section information into the ObjectCode. */
 956    for (i = 0; i < hdr->NumberOfSections; i++) {
 957       UChar* start;
 958       UChar* end;
 959
 960       SectionKind kind
 961          = SECTIONKIND_OTHER;
 962       COFF_section* sectab_i
 963          = (COFF_section*)
 964            myindex ( sizeof_COFF_section, i, sectab );
 965       /* fprintf ( stderr, "section name = %s\n", sectab_i->Name ); */
 966
 967 #if 0
 968       /* I'm sure this is the Right Way to do it.  However, the
 969          alternative of testing the sectab_i->Name field seems to
 970          work ok with Cygwin.
 971       */
 972       if (sectab_i->Characteristics & IMAGE_SCN_CNT_CODE ||
 973           sectab_i->Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA)
 974          kind = SECTIONKIND_CODE_OR_RODATA;
 975 #endif
 976
 977       if (0==strcmp(".text",sectab_i->Name))
 978          kind = SECTIONKIND_CODE_OR_RODATA;
 979       if (0==strcmp(".data",sectab_i->Name) ||
 980           0==strcmp(".bss",sectab_i->Name))
 981          kind = SECTIONKIND_RWDATA;
 982
 983       start = ((UChar*)(oc->image))
 984               + sectab_i->PointerToRawData;
 985       end   = start
 986               + sectab_i->SizeOfRawData - 1;
 987
 988       if (kind != SECTIONKIND_OTHER) {
 989          addSection ( oc, start, end, kind );
 990       } else {
 991          fprintf ( stderr, "unknown section name = `%s'\n",
 992                    sectab_i->Name);
 993          oc->errMsg("Unknown PEi386 section name");
 994          return FALSE;
 995       }
 996    }
 997
 998    return TRUE;
 999 }
1000
1001
1002 static int
1003 ocResolve_PEi386 ( ObjectCode* oc, int verb )
1004 {
1005    COFF_header*  hdr;
1006    COFF_section* sectab;
1007    COFF_symbol*  symtab;
1008    UChar*        strtab;
1009
1010    UInt32        A;
1011    UInt32        S;
1012    UInt32*       pP;
1013
1014    int i, j;
1015    char symbol[1000]; // ToDo
1016
1017    hdr = (COFF_header*)(oc->image);
1018    sectab = (COFF_section*) (
1019                ((UChar*)(oc->image))
1020                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1021             );
1022    symtab = (COFF_symbol*) (
1023                ((UChar*)(oc->image))
1024                + hdr->PointerToSymbolTable
1025             );
1026    strtab = ((UChar*)(oc->image))
1027             + hdr->PointerToSymbolTable
1028             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1029
1030    for (i = 0; i < hdr->NumberOfSections; i++) {
1031       COFF_section* sectab_i
1032          = (COFF_section*)
1033            myindex ( sizeof_COFF_section, i, sectab );
1034       COFF_reloc* reltab
1035          = (COFF_reloc*) (
1036               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1037            );
1038       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1039          COFF_symbol* sym;
1040          COFF_reloc* reltab_j
1041             = (COFF_reloc*)
1042               myindex ( sizeof_COFF_reloc, j, reltab );
1043
1044          /* the location to patch */
1045          pP = (UInt32*)(
1046                  ((UChar*)(oc->image))
1047                  + (sectab_i->PointerToRawData
1048                     + reltab_j->VirtualAddress)
1049               );
1050          /* the existing contents of pP */
1051          A = *pP;
1052          /* the symbol to connect to */
1053          sym = (COFF_symbol*)
1054                myindex ( sizeof_COFF_symbol,
1055                          reltab_j->SymbolTableIndex, symtab );
1056          if (verb) {
1057             fprintf ( stderr,
1058                    "reloc sec %2d num %3d:  type 0x%-4x   "
1059                    "vaddr 0x%-8x   name `",
1060                    i, j,
1061                    (UInt32)reltab_j->Type,
1062                    reltab_j->VirtualAddress );
1063             printName ( sym->Name, strtab );
1064             fprintf ( stderr, "'\n" );
1065          }
1066
1067          if (sym->StorageClass == IMAGE_SYM_CLASS_STATIC) {
1068             COFF_section* section_sym
1069                = findPEi386SectionCalled ( oc, sym->Name );
1070             if (!section_sym) {
1071                fprintf ( stderr, "bad section = `%s'\n", sym->Name );
1072                oc->errMsg("Can't find abovementioned PEi386 section");
1073                return FALSE;
1074             }
1075             S = ((UInt32)(oc->image))
1076                 + (section_sym->PointerToRawData
1077                    + sym->Value);
1078          } else {
1079          copyName ( sym->Name, strtab, symbol, 1000 );
1080          zapTrailingAtSign ( symbol );
1081          S = (UInt32) ocLookupSym ( oc, symbol );
1082          if (S == 0)
1083             S = (UInt32)(oc->clientLookup ( symbol ));
1084          if (S == 0) {
1085              belch("%s: unresolvable reference to `%s'", oc->fileName, symbol);
1086              return FALSE;
1087          }
1088          }
1089
1090          switch (reltab_j->Type) {
1091             case IMAGE_REL_I386_DIR32:
1092                *pP = A + S;
1093                break;
1094             case IMAGE_REL_I386_REL32:
1095                /* Tricky.  We have to insert a displacement at
1096                   pP which, when added to the PC for the _next_
1097                   insn, gives the address of the target (S).
1098                   Problem is to know the address of the next insn
1099                   when we only know pP.  We assume that this
1100                   literal field is always the last in the insn,
1101                   so that the address of the next insn is pP+4
1102                   -- hence the constant 4.
1103                   Also I don't know if A should be added, but so
1104                   far it has always been zero.
1105                */
1106                ASSERT(A==0);
1107                *pP = S - ((UInt32)pP) - 4;
1108                break;
1109             default:
1110                fprintf(stderr,
1111                        "unhandled PEi386 relocation type %d\n",
1112                        reltab_j->Type);
1113                oc->errMsg("unhandled PEi386 relocation type");
1114                return FALSE;
1115          }
1116
1117       }
1118    }
1119
1120    return TRUE;
1121 }
1122
1123 #endif /* defined(OBJFORMAT_PEi386) */
1124
1125
1126 /* --------------------------------------------------------------------------
1127  * ELF specifics
1128  * ------------------------------------------------------------------------*/
1129
1130 #if defined(OBJFORMAT_ELF)
1131
1132 #define FALSE 0
1133 #define TRUE  1
1134
1135 #include <elf.h>
1136
1137 static char *
1138 findElfSection ( void* objImage, Elf32_Word sh_type )
1139 {
1140    int i;
1141    char* ehdrC = (char*)objImage;
1142    Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1143    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1144    char* ptr = NULL;
1145    for (i = 0; i < ehdr->e_shnum; i++) {
1146       if (shdr[i].sh_type == sh_type &&
1147           i !=  ehdr->e_shstrndx) {
1148          ptr = ehdrC + shdr[i].sh_offset;
1149          break;
1150       }
1151    }
1152    return ptr;
1153 }
1154
1155
1156 static int
1157 ocVerifyImage_ELF ( ObjectCode* oc )
1158 {
1159    Elf32_Shdr* shdr;
1160    Elf32_Sym*  stab;
1161    int i, j, nent, nstrtab, nsymtabs;
1162    char* sh_strtab;
1163    char* strtab;
1164
1165    char*       ehdrC = (char*)(oc->image);
1166    Elf32_Ehdr* ehdr  = ( Elf32_Ehdr*)ehdrC;
1167
1168    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1169        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1170        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1171        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1172       belch("ocVerifyImage_ELF: not an ELF header");
1173       return 0;
1174    }
1175    IF_DEBUG(linker,belch( "Is an ELF header" ));
1176
1177    if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1178       belch("ocVerifyImage_ELF: not 32 bit ELF" );
1179       return 0;
1180    }
1181
1182    IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1183
1184    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1185        IF_DEBUG(linker,belch( "Is little-endian" ));
1186    } else
1187    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1188        IF_DEBUG(linker,belch( "Is big-endian" ));
1189    } else {
1190        belch("ocVerifyImage_ELF: unknown endiannness");
1191        return 0;
1192    }
1193
1194    if (ehdr->e_type != ET_REL) {
1195       belch("ocVerifyImage_ELF: not a relocatable object (.o) file");
1196       return 0;
1197    }
1198    IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1199
1200    IF_DEBUG(linker,belch( "Architecture is " ));
1201    switch (ehdr->e_machine) {
1202       case EM_386:   IF_DEBUG(linker,belch( "x86" )); break;
1203       case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1204       default:       IF_DEBUG(linker,belch( "unknown" ));
1205                      belch("ocVerifyImage_ELF: unknown architecture");
1206                      return 0;
1207    }
1208
1209    IF_DEBUG(linker,belch(
1210              "\nSection header table: start %d, n_entries %d, ent_size %d",
1211              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
1212
1213    ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1214
1215    shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1216
1217    if (ehdr->e_shstrndx == SHN_UNDEF) {
1218       belch("ocVerifyImage_ELF: no section header string table");
1219       return 0;
1220    } else {
1221       IF_DEBUG(linker,belch( "Section header string table is section %d",
1222                           ehdr->e_shstrndx));
1223       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1224    }
1225
1226    for (i = 0; i < ehdr->e_shnum; i++) {
1227       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
1228       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", shdr[i].sh_type ));
1229       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", shdr[i].sh_size ));
1230       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", shdr[i].sh_offset ));
1231       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
1232                ehdrC + shdr[i].sh_offset,
1233                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1234
1235       if (shdr[i].sh_type == SHT_REL) {
1236           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
1237       } else if (shdr[i].sh_type == SHT_RELA) {
1238           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1239       } else {
1240           IF_DEBUG(linker,fprintf(stderr,"     "));
1241       }
1242       if (sh_strtab) {
1243           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1244       }
1245    }
1246
1247    IF_DEBUG(linker,belch( "\nString tables" ));
1248    strtab = NULL;
1249    nstrtab = 0;
1250    for (i = 0; i < ehdr->e_shnum; i++) {
1251       if (shdr[i].sh_type == SHT_STRTAB &&
1252           i !=  ehdr->e_shstrndx) {
1253           IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
1254          strtab = ehdrC + shdr[i].sh_offset;
1255          nstrtab++;
1256       }
1257    }
1258    if (nstrtab != 1) {
1259       belch("ocVerifyImage_ELF: no string tables, or too many");
1260       return 0;
1261    }
1262
1263    nsymtabs = 0;
1264    IF_DEBUG(linker,belch( "\nSymbol tables" ));
1265    for (i = 0; i < ehdr->e_shnum; i++) {
1266       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1267       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1268       nsymtabs++;
1269       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1270       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1271       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
1272                nent,
1273                shdr[i].sh_size % sizeof(Elf32_Sym)
1274              ));
1275       if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1276          belch("ocVerifyImage_ELF: non-integral number of symbol table entries");
1277          return 0;
1278       }
1279       for (j = 0; j < nent; j++) {
1280          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
1281          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ",
1282                              (int)stab[j].st_shndx,
1283                              (int)stab[j].st_size,
1284                              (char*)stab[j].st_value ));
1285
1286          IF_DEBUG(linker,fprintf(stderr, "type=" ));
1287          switch (ELF32_ST_TYPE(stab[j].st_info)) {
1288             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1289             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1290             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
1291             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1292             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
1293             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
1294          }
1295          IF_DEBUG(linker,fprintf(stderr, "  " ));
1296
1297          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1298          switch (ELF32_ST_BIND(stab[j].st_info)) {
1299             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1300             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1301             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
1302             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
1303          }
1304          IF_DEBUG(linker,fprintf(stderr, "  " ));
1305
1306          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1307       }
1308    }
1309
1310    if (nsymtabs == 0) {
1311       belch("ocVerifyImage_ELF: didn't find any symbol tables");
1312       return 0;
1313    }
1314
1315    return 1;
1316 }
1317
1318
1319 static int
1320 ocGetNames_ELF ( ObjectCode* oc )
1321 {
1322    int i, j, k, nent;
1323    Elf32_Sym* stab;
1324
1325    char*       ehdrC      = (char*)(oc->image);
1326    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
1327    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
1328    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1329    char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1330
1331    if (!strtab) {
1332       belch("ocGetNames_ELF: no strtab");
1333       return 0;
1334    }
1335
1336    k = 0;
1337    oc->sections = stgMallocBytes( ehdr->e_shnum * sizeof(Section),
1338                                     "ocGetNames_ELF" );
1339    oc->n_sections = ehdr->e_shnum;
1340
1341    for (i = 0; i < ehdr->e_shnum; i++) {
1342
1343       /* make a section entry for relevant sections */
1344       SectionKind kind = SECTIONKIND_OTHER;
1345       if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
1346           !strcmp(".data1",sh_strtab+shdr[i].sh_name))
1347           kind = SECTIONKIND_RWDATA;
1348       if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
1349           !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
1350           !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
1351           kind = SECTIONKIND_CODE_OR_RODATA;
1352
1353       /* fill in the section info */
1354       oc->sections[i].start = ehdrC + shdr[i].sh_offset;
1355       oc->sections[i].end   = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
1356       oc->sections[i].kind  = kind;
1357
1358       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1359
1360       /* copy stuff into this module's object symbol table */
1361       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1362       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1363       oc->symbols = malloc(nent * sizeof(SymbolVal));
1364       oc->n_symbols = nent;
1365       for (j = 0; j < nent; j++) {
1366          if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL /* ||
1367                 ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL */
1368               )
1369               /* and not an undefined symbol */
1370               && stab[j].st_shndx != SHN_UNDEF
1371               &&
1372               /* and it's a not a section or string table or anything silly */
1373               ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1374                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1375                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE )
1376                 ) {
1377             char* nm = strtab + stab[j].st_name;
1378             char* ad = ehdrC
1379                        + shdr[ stab[j].st_shndx ].sh_offset
1380                        + stab[j].st_value;
1381             ASSERT(nm != NULL);
1382             ASSERT(ad != NULL);
1383             IF_DEBUG(linker,belch( "addOTabName: %10p  %s %s",
1384                        ad, oc->fileName, nm ));
1385             oc->symbols[j].lbl  = nm;
1386             oc->symbols[j].addr = ad;
1387             insertStrHashTable(symhash, nm, &(oc->symbols[j]));
1388          }
1389          else {
1390              IF_DEBUG(linker,belch( "skipping `%s'", strtab +
1391                              stab[j].st_name ));
1392              oc->symbols[j].lbl  = NULL;
1393              oc->symbols[j].addr = NULL;
1394          }
1395       }
1396    }
1397
1398    return 1;
1399 }
1400
1401
1402 static int
1403 ocResolve_ELF ( ObjectCode* oc )
1404 {
1405    char *strtab, *symbol;
1406    int   i, j;
1407    Elf32_Sym*  stab = NULL;
1408    char*       ehdrC = (char*)(oc->image);
1409    Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
1410    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1411    Elf32_Word* targ;
1412
1413    /* first find "the" symbol table */
1414    stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
1415
1416    /* also go find the string table */
1417    strtab = findElfSection ( ehdrC, SHT_STRTAB );
1418
1419    if (stab == NULL || strtab == NULL) {
1420       belch("ocResolve_ELF: can't find string or symbol table");
1421       return 0;
1422    }
1423
1424    for (i = 0; i < ehdr->e_shnum; i++) {
1425       if (shdr[i].sh_type == SHT_REL ) {
1426          Elf32_Rel*  rtab = (Elf32_Rel*) (ehdrC + shdr[i].sh_offset);
1427          int         nent = shdr[i].sh_size / sizeof(Elf32_Rel);
1428          int target_shndx = shdr[i].sh_info;
1429          int symtab_shndx = shdr[i].sh_link;
1430          stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1431          targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1432          IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1433                          target_shndx, symtab_shndx ));
1434          for (j = 0; j < nent; j++) {
1435             Elf32_Addr offset = rtab[j].r_offset;
1436             Elf32_Word info   = rtab[j].r_info;
1437
1438             Elf32_Addr  P = ((Elf32_Addr)targ) + offset;
1439             Elf32_Word* pP = (Elf32_Word*)P;
1440             Elf32_Addr  A = *pP;
1441             Elf32_Addr  S;
1442
1443             IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)   ",
1444                                 j, (void*)offset, (void*)info ));
1445             if (!info) {
1446                IF_DEBUG(linker,belch( " ZERO" ));
1447                S = 0;
1448             } else {
1449                /* First see if it is a nameless local symbol. */
1450                if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1451                    symbol = "(noname)";
1452                    S = (Elf32_Addr)(ehdrC
1453                                     + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1454                                     + stab[ELF32_R_SYM(info)].st_value
1455                        );
1456                } else {
1457                    /* No?  Should be in the symbol table then. */
1458                    symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1459                    (void *)S = lookupSymbol( symbol );
1460                }
1461                if (!S) {
1462                    barf("ocResolve_ELF: %s: unknown symbol `%s'",
1463                         oc->fileName, symbol);
1464                }
1465                IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1466             }
1467             IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n", (void*)P, (void*)S, (void*)A ));
1468             switch (ELF32_R_TYPE(info)) {
1469                case R_386_32:   *pP = S + A;     break;
1470                case R_386_PC32: *pP = S + A - P; break;
1471                default: fprintf(stderr,
1472                                 "unhandled ELF relocation type %d",
1473                                 ELF32_R_TYPE(info));
1474                         belch("ocResolve_ELF: unhandled ELF relocation type");
1475                         return 0;
1476             }
1477
1478          }
1479       }
1480       else
1481       if (shdr[i].sh_type == SHT_RELA) {
1482          belch("ocResolve_ELF: RelA style reloc table -- not yet done");
1483          return 0;
1484       }
1485    }
1486
1487    return 1;
1488 }
1489
1490
1491 #endif /* ELF */
1492
1493 /* -----------------------------------------------------------------------------
1494  * Look up an address to discover whether it is in text or data space.
1495  *
1496  * Used by the garbage collector when walking the stack.
1497  * -------------------------------------------------------------------------- */
1498
1499 static __inline__ SectionKind
1500 lookupSection ( void* addr )
1501 {
1502    int          i;
1503    ObjectCode*  oc;
1504
1505    for ( oc = objects; oc; oc = oc->next ) {
1506        for (i = 0; i < oc->n_sections; i++) {
1507            if (oc->sections[i].start <= addr
1508                && addr <= oc->sections[i].end)
1509                return oc->sections[i].kind;
1510        }
1511    }
1512    return SECTIONKIND_OTHER;
1513 }
1514
1515 int
1516 is_dynamically_loaded_code_or_rodata_ptr ( void* p )
1517 {
1518    SectionKind sk = lookupSection(p);
1519    ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
1520    return (sk == SECTIONKIND_CODE_OR_RODATA);
1521 }
1522
1523
1524 int
1525 is_dynamically_loaded_rwdata_ptr ( void* p )
1526 {
1527    SectionKind sk = lookupSection(p);
1528    ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
1529    return (sk == SECTIONKIND_RWDATA);
1530 }
1531
1532
1533 int
1534 is_not_dynamically_loaded_ptr ( void* p )
1535 {
1536    SectionKind sk = lookupSection(p);
1537    ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
1538    return (sk == SECTIONKIND_OTHER);
1539 }
1540
1541 #endif /* GHCI */