ghc/rts/Linker.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: Linker.c,v 1.17 2001/02/06 12:27:57 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    oc->fileName          = path;
 387    oc->fileSize          = st.st_size;
 388    oc->image             = stgMallocBytes( st.st_size, "loadObj(image)" );
 389    oc->symbols           = NULL;
 390    oc->sections          = NULL;
 391
 392    /* chain it onto the list of objects */
 393    oc->next              = objects;
 394    objects               = oc;
 395
 396    /* load the image into memory */
 397    f = fopen(path, "rb");
 398    if (!f) {
 399        barf("loadObj: can't read `%s'", path);
 400    }
 401    n = fread ( oc->image, 1, oc->fileSize, f );
 402    if (n != oc->fileSize) {
 403       fclose(f);
 404       barf("loadObj: error whilst reading `%s'", path);
 405    }
 406
 407    /* verify the in-memory image */
 408 #  if defined(OBJFORMAT_ELF)
 409    r = ocVerifyImage_ELF ( oc );
 410 #  elif defined(OBJFORMAT_PEi386)
 411    r = ocVerifyImage_PEi386 ( oc );
 412 #  else
 413    barf("loadObj: no verify method");
 414 #  endif
 415    if (!r) { return r; }
 416
 417    /* build the symbol list for this image */
 418 #  if defined(OBJFORMAT_ELF)
 419    r = ocGetNames_ELF ( oc );
 420 #  elif defined(OBJFORMAT_PEi386)
 421    r = ocGetNames_PEi386 ( oc );
 422 #  else
 423    barf("loadObj: no getNames method");
 424 #  endif
 425    if (!r) { return r; }
 426
 427    /* loaded, but not resolved yet */
 428    oc->status = OBJECT_LOADED;
 429
 430    return 1;
 431 }
 432
 433 /* -----------------------------------------------------------------------------
 434  * resolve all the currently unlinked objects in memory
 435  *
 436  * Returns: 1 if ok, 0 on error.
 437  */
 438 HsInt
 439 resolveObjs( void )
 440 {
 441     ObjectCode *oc;
 442     int r;
 443
 444     for (oc = objects; oc; oc = oc->next) {
 445         if (oc->status != OBJECT_RESOLVED) {
 446 #  if defined(OBJFORMAT_ELF)
 447             r = ocResolve_ELF ( oc );
 448 #  elif defined(OBJFORMAT_PEi386)
 449             r = ocResolve_PEi386 ( oc );
 450 #  else
 451             barf("link: not implemented on this platform");
 452 #  endif
 453             if (!r) { return r; }
 454             oc->status = OBJECT_RESOLVED;
 455         }
 456     }
 457     return 1;
 458 }
 459
 460 /* -----------------------------------------------------------------------------
 461  * delete an object from the pool
 462  */
 463 HsInt
 464 unloadObj( char *path )
 465 {
 466     ObjectCode *oc, *prev;
 467
 468     prev = NULL;
 469     for (oc = objects; oc; prev = oc, oc = oc->next) {
 470         if (!strcmp(oc->fileName,path)) {
 471
 472             /* Remove all the mappings for the symbols within this
 473              * object..
 474              */
 475             {
 476                 SymbolVal *s;
 477                 for (s = oc->symbols; s < oc->symbols + oc->n_symbols; s++) {
 478                     if (s->lbl != NULL) {
 479                         removeStrHashTable(symhash, s->lbl, NULL);
 480                     }
 481                 }
 482             }
 483
 484             if (prev == NULL) {
 485                 objects = oc->next;
 486             } else {
 487                 prev->next = oc->next;
 488             }
 489
 490             /* We're going to leave this in place, in case there are
 491                any pointers from the heap into it: */
 492             /* free(oc->image); */
 493             free(oc->symbols);
 494             free(oc->sections);
 495             free(oc);
 496             return 1;
 497         }
 498     }
 499
 500     belch("unloadObj: can't find `%s' to unload", path);
 501     return 0;
 502 }
 503
 504 /* --------------------------------------------------------------------------
 505  * PEi386 specifics (Win32 targets)
 506  * ------------------------------------------------------------------------*/
 507
 508 /* The information for this linker comes from
 509       Microsoft Portable Executable
 510       and Common Object File Format Specification
 511       revision 5.1 January 1998
 512    which SimonM says comes from the MS Developer Network CDs.
 513 */
 514
 515
 516 #if defined(OBJFORMAT_PEi386)
 517
 518
 519
 520 typedef unsigned char  UChar;
 521 typedef unsigned short UInt16;
 522 typedef unsigned int   UInt32;
 523 typedef          int   Int32;
 524
 525
 526 typedef
 527    struct {
 528       UInt16 Machine;
 529       UInt16 NumberOfSections;
 530       UInt32 TimeDateStamp;
 531       UInt32 PointerToSymbolTable;
 532       UInt32 NumberOfSymbols;
 533       UInt16 SizeOfOptionalHeader;
 534       UInt16 Characteristics;
 535    }
 536    COFF_header;
 537
 538 #define sizeof_COFF_header 20
 539
 540
 541 typedef
 542    struct {
 543       UChar  Name[8];
 544       UInt32 VirtualSize;
 545       UInt32 VirtualAddress;
 546       UInt32 SizeOfRawData;
 547       UInt32 PointerToRawData;
 548       UInt32 PointerToRelocations;
 549       UInt32 PointerToLinenumbers;
 550       UInt16 NumberOfRelocations;
 551       UInt16 NumberOfLineNumbers;
 552       UInt32 Characteristics;
 553    }
 554    COFF_section;
 555
 556 #define sizeof_COFF_section 40
 557
 558
 559 typedef
 560    struct {
 561       UChar  Name[8];
 562       UInt32 Value;
 563       UInt16 SectionNumber;
 564       UInt16 Type;
 565       UChar  StorageClass;
 566       UChar  NumberOfAuxSymbols;
 567    }
 568    COFF_symbol;
 569
 570 #define sizeof_COFF_symbol 18
 571
 572
 573 typedef
 574    struct {
 575       UInt32 VirtualAddress;
 576       UInt32 SymbolTableIndex;
 577       UInt16 Type;
 578    }
 579    COFF_reloc;
 580
 581 #define sizeof_COFF_reloc 10
 582
 583
 584 /* From PE spec doc, section 3.3.2 */
 585 #define IMAGE_FILE_RELOCS_STRIPPED     0x0001
 586 #define IMAGE_FILE_EXECUTABLE_IMAGE    0x0002
 587 #define IMAGE_FILE_DLL                 0x2000
 588 #define IMAGE_FILE_SYSTEM              0x1000
 589 #define IMAGE_FILE_BYTES_REVERSED_HI   0x8000
 590 #define IMAGE_FILE_BYTES_REVERSED_LO   0x0080
 591 #define IMAGE_FILE_32BIT_MACHINE       0x0100
 592
 593 /* From PE spec doc, section 5.4.2 and 5.4.4 */
 594 #define IMAGE_SYM_CLASS_EXTERNAL       2
 595 #define IMAGE_SYM_CLASS_STATIC         3
 596 #define IMAGE_SYM_UNDEFINED            0
 597
 598 /* From PE spec doc, section 4.1 */
 599 #define IMAGE_SCN_CNT_CODE             0x00000020
 600 #define IMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
 601
 602 /* From PE spec doc, section 5.2.1 */
 603 #define IMAGE_REL_I386_DIR32           0x0006
 604 #define IMAGE_REL_I386_REL32           0x0014
 605
 606
 607 /* We use myindex to calculate array addresses, rather than
 608    simply doing the normal subscript thing.  That's because
 609    some of the above structs have sizes which are not
 610    a whole number of words.  GCC rounds their sizes up to a
 611    whole number of words, which means that the address calcs
 612    arising from using normal C indexing or pointer arithmetic
 613    are just plain wrong.  Sigh.
 614 */
 615 static UChar *
 616 myindex ( int scale, int index, void* base )
 617 {
 618    return
 619       ((UChar*)base) + scale * index;
 620 }
 621
 622
 623 static void
 624 printName ( UChar* name, UChar* strtab )
 625 {
 626    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 627       UInt32 strtab_offset = * (UInt32*)(name+4);
 628       fprintf ( stderr, "%s", strtab + strtab_offset );
 629    } else {
 630       int i;
 631       for (i = 0; i < 8; i++) {
 632          if (name[i] == 0) break;
 633          fprintf ( stderr, "%c", name[i] );
 634       }
 635    }
 636 }
 637
 638
 639 static void
 640 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
 641 {
 642    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 643       UInt32 strtab_offset = * (UInt32*)(name+4);
 644       strncpy ( dst, strtab+strtab_offset, dstSize );
 645       dst[dstSize-1] = 0;
 646    } else {
 647       int i = 0;
 648       while (1) {
 649          if (i >= 8) break;
 650          if (name[i] == 0) break;
 651          dst[i] = name[i];
 652          i++;
 653       }
 654       dst[i] = 0;
 655    }
 656 }
 657
 658
 659 static UChar *
 660 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
 661 {
 662    UChar* newstr;
 663    /* If the string is longer than 8 bytes, look in the
 664       string table for it -- this will be correctly zero terminated.
 665    */
 666    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
 667       UInt32 strtab_offset = * (UInt32*)(name+4);
 668       return ((UChar*)strtab) + strtab_offset;
 669    }
 670    /* Otherwise, if shorter than 8 bytes, return the original,
 671       which by defn is correctly terminated.
 672    */
 673    if (name[7]==0) return name;
 674    /* The annoying case: 8 bytes.  Copy into a temporary
 675       (which is never freed ...)
 676    */
 677    newstr = malloc(9);
 678    if (newstr) {
 679       strncpy(newstr,name,8);
 680       newstr[8] = 0;
 681    }
 682    return newstr;
 683 }
 684
 685
 686 /* Just compares the short names (first 8 chars) */
 687 static COFF_section *
 688 findPEi386SectionCalled ( ObjectCode* oc,  char* name )
 689 {
 690    int i;
 691    COFF_header* hdr
 692       = (COFF_header*)(oc->image);
 693    COFF_section* sectab
 694       = (COFF_section*) (
 695            ((UChar*)(oc->image))
 696            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 697         );
 698    for (i = 0; i < hdr->NumberOfSections; i++) {
 699       UChar* n1;
 700       UChar* n2;
 701       COFF_section* section_i
 702          = (COFF_section*)
 703            myindex ( sizeof_COFF_section, i, sectab );
 704       n1 = (UChar*) &(section_i->Name);
 705       n2 = name;
 706       if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
 707           n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
 708           n1[6]==n2[6] && n1[7]==n2[7])
 709          return section_i;
 710    }
 711
 712    return NULL;
 713 }
 714
 715
 716 static void
 717 zapTrailingAtSign ( UChar* sym )
 718 {
 719    int i, j;
 720    if (sym[0] == 0) return;
 721    i = 0;
 722    while (sym[i] != 0) i++;
 723    i--;
 724    j = i;
 725    while (j > 0 && isdigit(sym[j])) j--;
 726    if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
 727 }
 728
 729
 730 static int
 731 ocVerifyImage_PEi386 ( ObjectCode* oc )
 732 {
 733    int i, j;
 734    COFF_header*  hdr;
 735    COFF_section* sectab;
 736    COFF_symbol*  symtab;
 737    UChar*        strtab;
 738
 739    hdr = (COFF_header*)(oc->image);
 740    sectab = (COFF_section*) (
 741                ((UChar*)(oc->image))
 742                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 743             );
 744    symtab = (COFF_symbol*) (
 745                ((UChar*)(oc->image))
 746                + hdr->PointerToSymbolTable
 747             );
 748    strtab = ((UChar*)(oc->image))
 749             + hdr->PointerToSymbolTable
 750             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 751
 752    if (hdr->Machine != 0x14c) {
 753       oc->errMsg("Not x86 PEi386");
 754       return FALSE;
 755    }
 756    if (hdr->SizeOfOptionalHeader != 0) {
 757       oc->errMsg("PEi386 with nonempty optional header");
 758       return FALSE;
 759    }
 760    if ( /* (hdr->Characteristics & IMAGE_FILE_RELOCS_STRIPPED) || */
 761         (hdr->Characteristics & IMAGE_FILE_EXECUTABLE_IMAGE) ||
 762         (hdr->Characteristics & IMAGE_FILE_DLL) ||
 763         (hdr->Characteristics & IMAGE_FILE_SYSTEM) ) {
 764       oc->errMsg("Not a PEi386 object file");
 765       return FALSE;
 766    }
 767    if ( (hdr->Characteristics & IMAGE_FILE_BYTES_REVERSED_HI) ||
 768         !(hdr->Characteristics & IMAGE_FILE_32BIT_MACHINE) ) {
 769       oc->errMsg("Invalid PEi386 word size or endiannness");
 770       return FALSE;
 771    }
 772
 773    if (!verb) return TRUE;
 774    /* No further verification after this point; only debug printing. */
 775
 776    fprintf ( stderr,
 777              "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
 778    fprintf ( stderr,
 779              "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
 780    fprintf ( stderr,
 781              "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
 782
 783    fprintf ( stderr, "\n" );
 784    fprintf ( stderr,
 785              "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
 786    fprintf ( stderr,
 787              "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
 788    fprintf ( stderr,
 789              "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
 790    fprintf ( stderr,
 791              "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
 792    fprintf ( stderr,
 793              "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
 794    fprintf ( stderr,
 795              "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
 796    fprintf ( stderr,
 797              "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
 798
 799    fprintf ( stderr, "\n" );
 800    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
 801    fprintf ( stderr, "---START of string table---\n");
 802    for (i = 4; i < *(UInt32*)strtab; i++) {
 803       if (strtab[i] == 0)
 804          fprintf ( stderr, "\n"); else
 805          fprintf( stderr, "%c", strtab[i] );
 806    }
 807    fprintf ( stderr, "--- END  of string table---\n");
 808
 809    fprintf ( stderr, "\n" );
 810    for (i = 0; i < hdr->NumberOfSections; i++) {
 811       COFF_reloc* reltab;
 812       COFF_section* sectab_i
 813          = (COFF_section*)
 814            myindex ( sizeof_COFF_section, i, sectab );
 815       fprintf ( stderr,
 816                 "\n"
 817                 "section %d\n"
 818                 "     name `",
 819                 i
 820               );
 821       printName ( sectab_i->Name, strtab );
 822       fprintf ( stderr,
 823                 "'\n"
 824                 "    vsize %d\n"
 825                 "    vaddr %d\n"
 826                 "  data sz %d\n"
 827                 " data off %d\n"
 828                 "  num rel %d\n"
 829                 "  off rel %d\n",
 830                 sectab_i->VirtualSize,
 831                 sectab_i->VirtualAddress,
 832                 sectab_i->SizeOfRawData,
 833                 sectab_i->PointerToRawData,
 834                 sectab_i->NumberOfRelocations,
 835                 sectab_i->PointerToRelocations
 836               );
 837       reltab = (COFF_reloc*) (
 838                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
 839                );
 840       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
 841          COFF_symbol* sym;
 842          COFF_reloc* rel = (COFF_reloc*)
 843                            myindex ( sizeof_COFF_reloc, j, reltab );
 844          fprintf ( stderr,
 845                    "        type 0x%-4x   vaddr 0x%-8x   name `",
 846                    (UInt32)rel->Type,
 847                    rel->VirtualAddress );
 848          sym = (COFF_symbol*)
 849                myindex ( sizeof_COFF_symbol, rel->SymbolTableIndex, symtab );
 850          printName ( sym->Name, strtab );
 851          fprintf ( stderr, "'\n" );
 852       }
 853       fprintf ( stderr, "\n" );
 854    }
 855
 856
 857    fprintf ( stderr, "\n" );
 858    i = 0;
 859    while (1) {
 860       COFF_symbol* symtab_i;
 861       if (i >= hdr->NumberOfSymbols) break;
 862       symtab_i = (COFF_symbol*)
 863                  myindex ( sizeof_COFF_symbol, i, symtab );
 864       fprintf ( stderr,
 865                 "symbol %d\n"
 866                 "     name `",
 867                 i
 868               );
 869       printName ( symtab_i->Name, strtab );
 870       fprintf ( stderr,
 871                 "'\n"
 872                 "    value 0x%x\n"
 873                 "     sec# %d\n"
 874                 "     type 0x%x\n"
 875                 "   sclass 0x%x\n"
 876                 "     nAux %d\n",
 877                 symtab_i->Value,
 878                 (Int32)(symtab_i->SectionNumber) - 1,
 879                 (UInt32)symtab_i->Type,
 880                 (UInt32)symtab_i->StorageClass,
 881                 (UInt32)symtab_i->NumberOfAuxSymbols
 882               );
 883       i += symtab_i->NumberOfAuxSymbols;
 884       i++;
 885    }
 886
 887    fprintf ( stderr, "\n" );
 888
 889    return TRUE;
 890 }
 891
 892
 893 static int
 894 ocGetNames_PEi386 ( ObjectCode* oc )
 895 {
 896    COFF_header*  hdr;
 897    COFF_section* sectab;
 898    COFF_symbol*  symtab;
 899    UChar*        strtab;
 900
 901    UChar* sname;
 902    void*  addr;
 903    int    i;
 904
 905    hdr = (COFF_header*)(oc->image);
 906    sectab = (COFF_section*) (
 907                ((UChar*)(oc->image))
 908                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
 909             );
 910    symtab = (COFF_symbol*) (
 911                ((UChar*)(oc->image))
 912                + hdr->PointerToSymbolTable
 913             );
 914    strtab = ((UChar*)(oc->image))
 915             + hdr->PointerToSymbolTable
 916             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
 917
 918    /* Copy exported symbols into the ObjectCode. */
 919    i = 0;
 920    while (1) {
 921       COFF_symbol* symtab_i;
 922       if (i >= hdr->NumberOfSymbols) break;
 923       symtab_i = (COFF_symbol*)
 924                  myindex ( sizeof_COFF_symbol, i, symtab );
 925
 926       if (symtab_i->StorageClass == IMAGE_SYM_CLASS_EXTERNAL &&
 927           symtab_i->SectionNumber != IMAGE_SYM_UNDEFINED) {
 928
 929          /* This symbol is global and defined, viz, exported */
 930          COFF_section* sectabent;
 931
 932          sname = cstring_from_COFF_symbol_name (
 933                     symtab_i->Name, strtab
 934                  );
 935          if (!sname) {
 936             oc->errMsg("Out of memory when copying PEi386 symbol");
 937             return FALSE;
 938          }
 939
 940          /* for IMAGE_SYMCLASS_EXTERNAL
 941                 && !IMAGE_SYM_UNDEFINED,
 942             the address of the symbol is:
 943                 address of relevant section + offset in section
 944          */
 945          sectabent = (COFF_section*)
 946                      myindex ( sizeof_COFF_section,
 947                                symtab_i->SectionNumber-1,
 948                                sectab );
 949          addr = ((UChar*)(oc->image))
 950                 + (sectabent->PointerToRawData
 951                    + symtab_i->Value);
 952          /* fprintf ( stderr, "addSymbol %p `%s'\n", addr,sname); */
 953          if (!addSymbol(oc,sname,addr)) return FALSE;
 954       }
 955       i += symtab_i->NumberOfAuxSymbols;
 956       i++;
 957    }
 958
 959    oc->sections = stgMallocBytes( NumberOfSections * sizeof(Section),
 960                                     "ocGetNamesPEi386" );
 961
 962    /* Copy section information into the ObjectCode. */
 963    for (i = 0; i < hdr->NumberOfSections; i++) {
 964       UChar* start;
 965       UChar* end;
 966
 967       SectionKind kind
 968          = SECTIONKIND_OTHER;
 969       COFF_section* sectab_i
 970          = (COFF_section*)
 971            myindex ( sizeof_COFF_section, i, sectab );
 972       /* fprintf ( stderr, "section name = %s\n", sectab_i->Name ); */
 973
 974 #if 0
 975       /* I'm sure this is the Right Way to do it.  However, the
 976          alternative of testing the sectab_i->Name field seems to
 977          work ok with Cygwin.
 978       */
 979       if (sectab_i->Characteristics & IMAGE_SCN_CNT_CODE ||
 980           sectab_i->Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA)
 981          kind = SECTIONKIND_CODE_OR_RODATA;
 982 #endif
 983
 984       if (0==strcmp(".text",sectab_i->Name))
 985          kind = SECTIONKIND_CODE_OR_RODATA;
 986       if (0==strcmp(".data",sectab_i->Name) ||
 987           0==strcmp(".bss",sectab_i->Name))
 988          kind = SECTIONKIND_RWDATA;
 989
 990       start = ((UChar*)(oc->image))
 991               + sectab_i->PointerToRawData;
 992       end   = start
 993               + sectab_i->SizeOfRawData - 1;
 994
 995       if (kind != SECTIONKIND_OTHER) {
 996          addSection ( oc, start, end, kind );
 997       } else {
 998          fprintf ( stderr, "unknown section name = `%s'\n",
 999                    sectab_i->Name);
1000          oc->errMsg("Unknown PEi386 section name");
1001          return FALSE;
1002       }
1003    }
1004
1005    return TRUE;
1006 }
1007
1008
1009 static int
1010 ocResolve_PEi386 ( ObjectCode* oc, int verb )
1011 {
1012    COFF_header*  hdr;
1013    COFF_section* sectab;
1014    COFF_symbol*  symtab;
1015    UChar*        strtab;
1016
1017    UInt32        A;
1018    UInt32        S;
1019    UInt32*       pP;
1020
1021    int i, j;
1022    char symbol[1000]; // ToDo
1023
1024    hdr = (COFF_header*)(oc->image);
1025    sectab = (COFF_section*) (
1026                ((UChar*)(oc->image))
1027                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1028             );
1029    symtab = (COFF_symbol*) (
1030                ((UChar*)(oc->image))
1031                + hdr->PointerToSymbolTable
1032             );
1033    strtab = ((UChar*)(oc->image))
1034             + hdr->PointerToSymbolTable
1035             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1036
1037    for (i = 0; i < hdr->NumberOfSections; i++) {
1038       COFF_section* sectab_i
1039          = (COFF_section*)
1040            myindex ( sizeof_COFF_section, i, sectab );
1041       COFF_reloc* reltab
1042          = (COFF_reloc*) (
1043               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1044            );
1045       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1046          COFF_symbol* sym;
1047          COFF_reloc* reltab_j
1048             = (COFF_reloc*)
1049               myindex ( sizeof_COFF_reloc, j, reltab );
1050
1051          /* the location to patch */
1052          pP = (UInt32*)(
1053                  ((UChar*)(oc->image))
1054                  + (sectab_i->PointerToRawData
1055                     + reltab_j->VirtualAddress)
1056               );
1057          /* the existing contents of pP */
1058          A = *pP;
1059          /* the symbol to connect to */
1060          sym = (COFF_symbol*)
1061                myindex ( sizeof_COFF_symbol,
1062                          reltab_j->SymbolTableIndex, symtab );
1063          if (verb) {
1064             fprintf ( stderr,
1065                    "reloc sec %2d num %3d:  type 0x%-4x   "
1066                    "vaddr 0x%-8x   name `",
1067                    i, j,
1068                    (UInt32)reltab_j->Type,
1069                    reltab_j->VirtualAddress );
1070             printName ( sym->Name, strtab );
1071             fprintf ( stderr, "'\n" );
1072          }
1073
1074          if (sym->StorageClass == IMAGE_SYM_CLASS_STATIC) {
1075             COFF_section* section_sym
1076                = findPEi386SectionCalled ( oc, sym->Name );
1077             if (!section_sym) {
1078                fprintf ( stderr, "bad section = `%s'\n", sym->Name );
1079                oc->errMsg("Can't find abovementioned PEi386 section");
1080                return FALSE;
1081             }
1082             S = ((UInt32)(oc->image))
1083                 + (section_sym->PointerToRawData
1084                    + sym->Value);
1085          } else {
1086          copyName ( sym->Name, strtab, symbol, 1000 );
1087          zapTrailingAtSign ( symbol );
1088          S = (UInt32) ocLookupSym ( oc, symbol );
1089          if (S == 0)
1090             S = (UInt32)(oc->clientLookup ( symbol ));
1091          if (S == 0) {
1092              belch("%s: unresolvable reference to `%s'", oc->fileName, symbol);
1093              return FALSE;
1094          }
1095          }
1096
1097          switch (reltab_j->Type) {
1098             case IMAGE_REL_I386_DIR32:
1099                *pP = A + S;
1100                break;
1101             case IMAGE_REL_I386_REL32:
1102                /* Tricky.  We have to insert a displacement at
1103                   pP which, when added to the PC for the _next_
1104                   insn, gives the address of the target (S).
1105                   Problem is to know the address of the next insn
1106                   when we only know pP.  We assume that this
1107                   literal field is always the last in the insn,
1108                   so that the address of the next insn is pP+4
1109                   -- hence the constant 4.
1110                   Also I don't know if A should be added, but so
1111                   far it has always been zero.
1112                */
1113                ASSERT(A==0);
1114                *pP = S - ((UInt32)pP) - 4;
1115                break;
1116             default:
1117                fprintf(stderr,
1118                        "unhandled PEi386 relocation type %d\n",
1119                        reltab_j->Type);
1120                oc->errMsg("unhandled PEi386 relocation type");
1121                return FALSE;
1122          }
1123
1124       }
1125    }
1126
1127    return TRUE;
1128 }
1129
1130 #endif /* defined(OBJFORMAT_PEi386) */
1131
1132
1133 /* --------------------------------------------------------------------------
1134  * ELF specifics
1135  * ------------------------------------------------------------------------*/
1136
1137 #if defined(OBJFORMAT_ELF)
1138
1139 #define FALSE 0
1140 #define TRUE  1
1141
1142 #include <elf.h>
1143
1144 static char *
1145 findElfSection ( void* objImage, Elf32_Word sh_type )
1146 {
1147    int i;
1148    char* ehdrC = (char*)objImage;
1149    Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1150    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1151    char* ptr = NULL;
1152    for (i = 0; i < ehdr->e_shnum; i++) {
1153       if (shdr[i].sh_type == sh_type &&
1154           i !=  ehdr->e_shstrndx) {
1155          ptr = ehdrC + shdr[i].sh_offset;
1156          break;
1157       }
1158    }
1159    return ptr;
1160 }
1161
1162
1163 static int
1164 ocVerifyImage_ELF ( ObjectCode* oc )
1165 {
1166    Elf32_Shdr* shdr;
1167    Elf32_Sym*  stab;
1168    int i, j, nent, nstrtab, nsymtabs;
1169    char* sh_strtab;
1170    char* strtab;
1171
1172    char*       ehdrC = (char*)(oc->image);
1173    Elf32_Ehdr* ehdr  = ( Elf32_Ehdr*)ehdrC;
1174
1175    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1176        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1177        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1178        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1179       belch("ocVerifyImage_ELF: not an ELF header");
1180       return 0;
1181    }
1182    IF_DEBUG(linker,belch( "Is an ELF header" ));
1183
1184    if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1185       belch("ocVerifyImage_ELF: not 32 bit ELF" );
1186       return 0;
1187    }
1188
1189    IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1190
1191    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1192        IF_DEBUG(linker,belch( "Is little-endian" ));
1193    } else
1194    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1195        IF_DEBUG(linker,belch( "Is big-endian" ));
1196    } else {
1197        belch("ocVerifyImage_ELF: unknown endiannness");
1198        return 0;
1199    }
1200
1201    if (ehdr->e_type != ET_REL) {
1202       belch("ocVerifyImage_ELF: not a relocatable object (.o) file");
1203       return 0;
1204    }
1205    IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1206
1207    IF_DEBUG(linker,belch( "Architecture is " ));
1208    switch (ehdr->e_machine) {
1209       case EM_386:   IF_DEBUG(linker,belch( "x86" )); break;
1210       case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1211       default:       IF_DEBUG(linker,belch( "unknown" ));
1212                      belch("ocVerifyImage_ELF: unknown architecture");
1213                      return 0;
1214    }
1215
1216    IF_DEBUG(linker,belch(
1217              "\nSection header table: start %d, n_entries %d, ent_size %d",
1218              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
1219
1220    ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1221
1222    shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1223
1224    if (ehdr->e_shstrndx == SHN_UNDEF) {
1225       belch("ocVerifyImage_ELF: no section header string table");
1226       return 0;
1227    } else {
1228       IF_DEBUG(linker,belch( "Section header string table is section %d",
1229                           ehdr->e_shstrndx));
1230       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1231    }
1232
1233    for (i = 0; i < ehdr->e_shnum; i++) {
1234       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
1235       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", shdr[i].sh_type ));
1236       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", shdr[i].sh_size ));
1237       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", shdr[i].sh_offset ));
1238       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
1239                ehdrC + shdr[i].sh_offset,
1240                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1241
1242       if (shdr[i].sh_type == SHT_REL) {
1243           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
1244       } else if (shdr[i].sh_type == SHT_RELA) {
1245           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1246       } else {
1247           IF_DEBUG(linker,fprintf(stderr,"     "));
1248       }
1249       if (sh_strtab) {
1250           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1251       }
1252    }
1253
1254    IF_DEBUG(linker,belch( "\nString tables" ));
1255    strtab = NULL;
1256    nstrtab = 0;
1257    for (i = 0; i < ehdr->e_shnum; i++) {
1258       if (shdr[i].sh_type == SHT_STRTAB &&
1259           i !=  ehdr->e_shstrndx) {
1260           IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
1261          strtab = ehdrC + shdr[i].sh_offset;
1262          nstrtab++;
1263       }
1264    }
1265    if (nstrtab != 1) {
1266       belch("ocVerifyImage_ELF: no string tables, or too many");
1267       return 0;
1268    }
1269
1270    nsymtabs = 0;
1271    IF_DEBUG(linker,belch( "\nSymbol tables" ));
1272    for (i = 0; i < ehdr->e_shnum; i++) {
1273       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1274       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1275       nsymtabs++;
1276       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1277       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1278       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
1279                nent,
1280                shdr[i].sh_size % sizeof(Elf32_Sym)
1281              ));
1282       if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1283          belch("ocVerifyImage_ELF: non-integral number of symbol table entries");
1284          return 0;
1285       }
1286       for (j = 0; j < nent; j++) {
1287          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
1288          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ",
1289                              (int)stab[j].st_shndx,
1290                              (int)stab[j].st_size,
1291                              (char*)stab[j].st_value ));
1292
1293          IF_DEBUG(linker,fprintf(stderr, "type=" ));
1294          switch (ELF32_ST_TYPE(stab[j].st_info)) {
1295             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1296             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1297             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
1298             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1299             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
1300             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
1301          }
1302          IF_DEBUG(linker,fprintf(stderr, "  " ));
1303
1304          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1305          switch (ELF32_ST_BIND(stab[j].st_info)) {
1306             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1307             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1308             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
1309             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
1310          }
1311          IF_DEBUG(linker,fprintf(stderr, "  " ));
1312
1313          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1314       }
1315    }
1316
1317    if (nsymtabs == 0) {
1318       belch("ocVerifyImage_ELF: didn't find any symbol tables");
1319       return 0;
1320    }
1321
1322    return 1;
1323 }
1324
1325
1326 static int
1327 ocGetNames_ELF ( ObjectCode* oc )
1328 {
1329    int i, j, k, nent;
1330    Elf32_Sym* stab;
1331
1332    char*       ehdrC      = (char*)(oc->image);
1333    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
1334    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
1335    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1336    char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1337
1338    if (!strtab) {
1339       belch("ocGetNames_ELF: no strtab");
1340       return 0;
1341    }
1342
1343    k = 0;
1344    oc->sections = stgMallocBytes( ehdr->e_shnum * sizeof(Section),
1345                                     "ocGetNames_ELF" );
1346    oc->n_sections = ehdr->e_shnum;
1347
1348    for (i = 0; i < ehdr->e_shnum; i++) {
1349
1350       /* make a section entry for relevant sections */
1351       SectionKind kind = SECTIONKIND_OTHER;
1352       if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
1353           !strcmp(".data1",sh_strtab+shdr[i].sh_name))
1354           kind = SECTIONKIND_RWDATA;
1355       if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
1356           !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
1357           !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
1358           kind = SECTIONKIND_CODE_OR_RODATA;
1359
1360       /* fill in the section info */
1361       oc->sections[i].start = ehdrC + shdr[i].sh_offset;
1362       oc->sections[i].end   = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
1363       oc->sections[i].kind  = kind;
1364
1365       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1366
1367       /* copy stuff into this module's object symbol table */
1368       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1369       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1370       oc->symbols = malloc(nent * sizeof(SymbolVal));
1371       oc->n_symbols = nent;
1372       for (j = 0; j < nent; j++) {
1373          if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL /* ||
1374                 ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL */
1375               )
1376               /* and not an undefined symbol */
1377               && stab[j].st_shndx != SHN_UNDEF
1378               &&
1379               /* and it's a not a section or string table or anything silly */
1380               ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1381                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1382                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE )
1383                 ) {
1384             char* nm = strtab + stab[j].st_name;
1385             char* ad = ehdrC
1386                        + shdr[ stab[j].st_shndx ].sh_offset
1387                        + stab[j].st_value;
1388             ASSERT(nm != NULL);
1389             ASSERT(ad != NULL);
1390             IF_DEBUG(linker,belch( "addOTabName: %10p  %s %s",
1391                        ad, oc->fileName, nm ));
1392             oc->symbols[j].lbl  = nm;
1393             oc->symbols[j].addr = ad;
1394             insertStrHashTable(symhash, nm, &(oc->symbols[j]));
1395          }
1396          else {
1397              IF_DEBUG(linker,belch( "skipping `%s'", strtab +
1398                              stab[j].st_name ));
1399              oc->symbols[j].lbl  = NULL;
1400              oc->symbols[j].addr = NULL;
1401          }
1402       }
1403    }
1404
1405    return 1;
1406 }
1407
1408
1409 static int
1410 ocResolve_ELF ( ObjectCode* oc )
1411 {
1412    char *strtab, *symbol;
1413    int   i, j;
1414    Elf32_Sym*  stab = NULL;
1415    char*       ehdrC = (char*)(oc->image);
1416    Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
1417    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1418    Elf32_Word* targ;
1419
1420    /* first find "the" symbol table */
1421    stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
1422
1423    /* also go find the string table */
1424    strtab = findElfSection ( ehdrC, SHT_STRTAB );
1425
1426    if (stab == NULL || strtab == NULL) {
1427       belch("ocResolve_ELF: can't find string or symbol table");
1428       return 0;
1429    }
1430
1431    for (i = 0; i < ehdr->e_shnum; i++) {
1432       if (shdr[i].sh_type == SHT_REL ) {
1433          Elf32_Rel*  rtab = (Elf32_Rel*) (ehdrC + shdr[i].sh_offset);
1434          int         nent = shdr[i].sh_size / sizeof(Elf32_Rel);
1435          int target_shndx = shdr[i].sh_info;
1436          int symtab_shndx = shdr[i].sh_link;
1437          stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1438          targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1439          IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1440                          target_shndx, symtab_shndx ));
1441          for (j = 0; j < nent; j++) {
1442             Elf32_Addr offset = rtab[j].r_offset;
1443             Elf32_Word info   = rtab[j].r_info;
1444
1445             Elf32_Addr  P = ((Elf32_Addr)targ) + offset;
1446             Elf32_Word* pP = (Elf32_Word*)P;
1447             Elf32_Addr  A = *pP;
1448             Elf32_Addr  S;
1449
1450             IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)   ",
1451                                 j, (void*)offset, (void*)info ));
1452             if (!info) {
1453                IF_DEBUG(linker,belch( " ZERO" ));
1454                S = 0;
1455             } else {
1456                /* First see if it is a nameless local symbol. */
1457                if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1458                    symbol = "(noname)";
1459                    S = (Elf32_Addr)(ehdrC
1460                                     + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1461                                     + stab[ELF32_R_SYM(info)].st_value
1462                        );
1463                } else {
1464                    /* No?  Should be in the symbol table then. */
1465                    symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1466                    (void *)S = lookupSymbol( symbol );
1467                }
1468                if (!S) {
1469                    barf("ocResolve_ELF: %s: unknown symbol `%s'",
1470                         oc->fileName, symbol);
1471                }
1472                IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1473             }
1474             IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n", (void*)P, (void*)S, (void*)A ));
1475             switch (ELF32_R_TYPE(info)) {
1476                case R_386_32:   *pP = S + A;     break;
1477                case R_386_PC32: *pP = S + A - P; break;
1478                default: fprintf(stderr,
1479                                 "unhandled ELF relocation type %d",
1480                                 ELF32_R_TYPE(info));
1481                         belch("ocResolve_ELF: unhandled ELF relocation type");
1482                         return 0;
1483             }
1484
1485          }
1486       }
1487       else
1488       if (shdr[i].sh_type == SHT_RELA) {
1489          belch("ocResolve_ELF: RelA style reloc table -- not yet done");
1490          return 0;
1491       }
1492    }
1493
1494    return 1;
1495 }
1496
1497
1498 #endif /* ELF */
1499
1500 /* -----------------------------------------------------------------------------
1501  * Look up an address to discover whether it is in text or data space.
1502  *
1503  * Used by the garbage collector when walking the stack.
1504  * -------------------------------------------------------------------------- */
1505
1506 static __inline__ SectionKind
1507 lookupSection ( void* addr )
1508 {
1509    int          i;
1510    ObjectCode*  oc;
1511
1512    for ( oc = objects; oc; oc = oc->next ) {
1513        for (i = 0; i < oc->n_sections; i++) {
1514            if (oc->sections[i].start <= addr
1515                && addr <= oc->sections[i].end)
1516                return oc->sections[i].kind;
1517        }
1518    }
1519    return SECTIONKIND_OTHER;
1520 }
1521
1522 int
1523 is_dynamically_loaded_code_or_rodata_ptr ( void* p )
1524 {
1525    SectionKind sk = lookupSection(p);
1526    ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
1527    return (sk == SECTIONKIND_CODE_OR_RODATA);
1528 }
1529
1530
1531 int
1532 is_dynamically_loaded_rwdata_ptr ( void* p )
1533 {
1534    SectionKind sk = lookupSection(p);
1535    ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
1536    return (sk == SECTIONKIND_RWDATA);
1537 }
1538
1539
1540 int
1541 is_not_dynamically_loaded_ptr ( void* p )
1542 {
1543    SectionKind sk = lookupSection(p);
1544    ASSERT (sk != SECTIONKIND_NOINFOAVAIL);
1545    return (sk == SECTIONKIND_OTHER);
1546 }
1547
1548 #endif /* GHCI */