ghc/rts/Linker.c

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