ghc/rts/Linker.c

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