ghc/rts/Linker.c

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