ghc/rts/Linker.c

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