ghc/rts/Linker.c

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