ghc/rts/Linker.c

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