ghc/rts/Linker.c

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