ghc/rts/Linker.c

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