ghc/rts/Linker.c

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