ghc/rts/Linker.c

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