ghc/rts/Linker.c

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